428f0763_67jCiHbdgfGlgAOJqfg9A tools/ioemu/x86_64.ld
3fbba6dbDfYvJSsw9500b4SZyUhxjQ tools/libxc/Makefile
41dde8afKYRKxS4XtLv1KUegGQy_bg tools/libxc/linux_boot_params.h
+42a0c8d8qbLfvuvDUA0tFB9nHMh-zg tools/libxc/list.h
41cc934abX-QLXJXW_clV_wRjM0zYg tools/libxc/plan9a.out.h
3fbba6dc1uU7U3IFeF6A-XEOYF2MkQ tools/libxc/rpm.spec
3fbba6dcrNxtygEcgJYAJJ1gCQqfsA tools/libxc/xc.h
3fbba6dbEVkVMX0JuDFzap9jeaucGA tools/libxc/xc_bvtsched.c
4273458dyF2_sKA6CFkNJQYb8eY2dA tools/libxc/xc_core.c
+42a0c8d98XtmbhyddBgIyyHllz5WTw tools/libxc/xc_debug.c
+42a0c8d9ucRxWO41IHTfYI7xYGoKrw tools/libxc/xc_debug.h
3fbba6dbasJQV-MVElDC0DGSHMiL5w tools/libxc/xc_domain.c
40278d99BLsfUv3qxv0I8C1sClZ0ow tools/libxc/xc_elf.h
403e0977Bjsm_e82pwvl9VvaJxh8Gg tools/libxc/xc_evtchn.c
41adc641dV-0cDLSyzMs5BT8nL7v3Q tools/misc/xenperf.c
4056f5155QYZdsk-1fLdjsZPFTnlhg tools/misc/xensymoops
40cf2937dqM1jWW87O5OoOYND8leuA tools/misc/xm
+42a0c8d9zuGuWoaTux5NW4N3wOw8pg tools/pdb/Domain.ml
+42a0c8d9pigEXFFtdut3R99jbf73NA tools/pdb/Domain.mli
+42a0c8d93wnR_hcSAa7VHgn8CSrWEA tools/pdb/Intel.ml
+42a0c8d95glt-jkgXe8GDOPT6TYN6Q tools/pdb/Makefile
+42a0c8d9UueJDF0IRX3OozEvUhSTmw tools/pdb/OCamlMakefile
+42a0c8d9PgBvaWPzTHSFb9ngii7c7w tools/pdb/PDB.ml
+42a0c8danHHGiNywdeer6j4jzxAc2A tools/pdb/Process.ml
+42a0c8dav_08OtySI4kYP1lahlVrpQ tools/pdb/Process.mli
+42a0c8da51EqubQT5PJ4sxCKLF3xSw tools/pdb/Util.ml
+42a0c8daxftpiXuvLmc9fOOEhdFWiQ tools/pdb/debugger.ml
+42a0c8da81tzhpvIAfkx9nZqUNrQvg tools/pdb/evtchn.ml
+42a0c8dasiso9c-2sCvHBzP6YVjATA tools/pdb/evtchn.mli
+42a0c8daXD_6Y62A_u5-PO_Klrhi0w tools/pdb/pdb_caml_xc.c
+42a0c8danJXun9ay5SPBhhkKvuUPfg tools/pdb/pdb_xen.c
+42a0c8dbjK6Du89D2SUcxsuAdlUu3w tools/pdb/server.ml
4270cc81g3nSNYCZ1ryCMDEbLtMtbQ tools/pygrub/Makefile
4270deeccyRsJn6jLnRh9odRtMW9SA tools/pygrub/README
4270cc81EIl7NyaS3Av6IPRk2c2a6Q tools/pygrub/setup.py
+ach61@arcadians.cl.cam.ac.uk
ach61@boulderdash.cl.cam.ac.uk
ach61@labyrinth.cl.cam.ac.uk
ach61@soar.cl.cam.ac.uk
SRCS += xc_bvtsched.c
SRCS += xc_core.c
SRCS += xc_domain.c
+SRCS += xc_debug.c
SRCS += xc_evtchn.c
SRCS += xc_gnttab.c
SRCS += xc_linux_build.c
mv staging/i386/*.rpm .
rm -rf staging
-libxc.a: $(LIB_OBJS)
+libxc.a: $(OBJS)
$(AR) rc $@ $^
libxc.so: libxc.so.$(MAJOR)
--- /dev/null
+#ifndef _LINUX_LIST_H
+#define _LINUX_LIST_H
+
+/*
+ * Simple doubly linked list implementation.
+ *
+ * Some of the internal functions ("__xxx") are useful when
+ * manipulating whole lists rather than single entries, as
+ * sometimes we already know the next/prev entries and we can
+ * generate better code by using them directly rather than
+ * using the generic single-entry routines.
+ */
+
+struct list_head {
+ struct list_head *next, *prev;
+};
+
+#define LIST_HEAD_INIT(name) { &(name), &(name) }
+
+#define LIST_HEAD(name) \
+ struct list_head name = LIST_HEAD_INIT(name)
+
+#define INIT_LIST_HEAD(ptr) do { \
+ (ptr)->next = (ptr); (ptr)->prev = (ptr); \
+} while (0)
+
+/*
+ * Insert a new entry between two known consecutive entries.
+ *
+ * This is only for internal list manipulation where we know
+ * the prev/next entries already!
+ */
+static __inline__ void __list_add(struct list_head * new,
+ struct list_head * prev,
+ struct list_head * next)
+{
+ next->prev = new;
+ new->next = next;
+ new->prev = prev;
+ prev->next = new;
+}
+
+/**
+ * list_add - add a new entry
+ * @new: new entry to be added
+ * @head: list head to add it after
+ *
+ * Insert a new entry after the specified head.
+ * This is good for implementing stacks.
+ */
+static __inline__ void list_add(struct list_head *new, struct list_head *head)
+{
+ __list_add(new, head, head->next);
+}
+
+/**
+ * list_add_tail - add a new entry
+ * @new: new entry to be added
+ * @head: list head to add it before
+ *
+ * Insert a new entry before the specified head.
+ * This is useful for implementing queues.
+ */
+static __inline__ void list_add_tail(struct list_head *new, struct list_head *head)
+{
+ __list_add(new, head->prev, head);
+}
+
+/*
+ * Delete a list entry by making the prev/next entries
+ * point to each other.
+ *
+ * This is only for internal list manipulation where we know
+ * the prev/next entries already!
+ */
+static __inline__ void __list_del(struct list_head * prev,
+ struct list_head * next)
+{
+ next->prev = prev;
+ prev->next = next;
+}
+
+/**
+ * list_del - deletes entry from list.
+ * @entry: the element to delete from the list.
+ * Note: list_empty on entry does not return true after this, the entry is in an undefined state.
+ */
+static __inline__ void list_del(struct list_head *entry)
+{
+ __list_del(entry->prev, entry->next);
+}
+
+/**
+ * list_del_init - deletes entry from list and reinitialize it.
+ * @entry: the element to delete from the list.
+ */
+static __inline__ void list_del_init(struct list_head *entry)
+{
+ __list_del(entry->prev, entry->next);
+ INIT_LIST_HEAD(entry);
+}
+
+/**
+ * list_empty - tests whether a list is empty
+ * @head: the list to test.
+ */
+static __inline__ int list_empty(struct list_head *head)
+{
+ return head->next == head;
+}
+
+/**
+ * list_splice - join two lists
+ * @list: the new list to add.
+ * @head: the place to add it in the first list.
+ */
+static __inline__ void list_splice(struct list_head *list, struct list_head *head)
+{
+ struct list_head *first = list->next;
+
+ if (first != list) {
+ struct list_head *last = list->prev;
+ struct list_head *at = head->next;
+
+ first->prev = head;
+ head->next = first;
+
+ last->next = at;
+ at->prev = last;
+ }
+}
+
+/**
+ * list_entry - get the struct for this entry
+ * @ptr: the &struct list_head pointer.
+ * @type: the type of the struct this is embedded in.
+ * @member: the name of the list_struct within the struct.
+ */
+#define list_entry(ptr, type, member) \
+ ((type *)((char *)(ptr)-(unsigned long)(&((type *)0)->member)))
+
+/**
+ * list_for_each - iterate over a list
+ * @pos: the &struct list_head to use as a loop counter.
+ * @head: the head for your list.
+ */
+#define list_for_each(pos, head) \
+ for (pos = (head)->next; pos != (head); pos = pos->next)
+
+/**
+ * list_for_each_safe - iterate over a list safe against removal of list entry
+ * @pos: the &struct list_head to use as a loop counter.
+ * @n: another &struct list_head to use as temporary storage
+ * @head: the head for your list.
+ */
+#define list_for_each_safe(pos, n, head) \
+ for (pos = (head)->next, n = pos->next; pos != (head); \
+ pos = n, n = pos->next)
+
+/**
+ * list_for_each_entry - iterate over list of given type
+ * @pos: the type * to use as a loop counter.
+ * @head: the head for your list.
+ * @member: the name of the list_struct within the struct.
+ */
+#define list_for_each_entry(pos, head, member) \
+ for (pos = list_entry((head)->next, typeof(*pos), member), \
+ prefetch(pos->member.next); \
+ &pos->member != (head); \
+ pos = list_entry(pos->member.next, typeof(*pos), member), \
+ prefetch(pos->member.next))
+
+/**
+ * list_for_each_entry_safe - iterate over list of given type safe against removal of list entry
+ * @pos: the type * to use as a loop counter.
+ * @n: another type * to use as temporary storage
+ * @head: the head for your list.
+ * @member: the name of the list_struct within the struct.
+ */
+#define list_for_each_entry_safe(pos, n, head, member) \
+ for (pos = list_entry((head)->next, typeof(*pos), member), \
+ n = list_entry(pos->member.next, typeof(*pos), member); \
+ &pos->member != (head); \
+ pos = n, n = list_entry(n->member.next, typeof(*n), member))
+#endif /* _LINUX_LIST_H */
+
--- /dev/null
+/*
+ * xc_debug.c
+ *
+ * alex ho
+ * http://www.cl.cam.ac.uk/netos/pdb
+ *
+ * xc_debug_memory_page adapted from xc_ptrace.c
+ */
+
+#include "xc_private.h"
+#include "list.h"
+
+/* from xen/include/asm-x86/processor.h */
+#define X86_EFLAGS_TF 0x00000100 /* Trap Flag */
+
+typedef int boolean;
+#define true 1
+#define false 0
+
+
+typedef struct bwcpoint /* break/watch/catch point */
+{
+ struct list_head list;
+ memory_t address;
+ u32 domain;
+ u16 vcpu;
+ u8 old_value; /* old value for software bkpt */
+} bwcpoint_t, *bwcpoint_p;
+
+static bwcpoint_t bwcpoint_list;
+
+
+
+typedef struct domain_context /* local cache of domain state */
+{
+ struct list_head list;
+ u32 domid;
+ boolean valid[MAX_VIRT_CPUS];
+ vcpu_guest_context_t context[MAX_VIRT_CPUS];
+
+ long total_pages;
+ unsigned long *page_array;
+
+ unsigned long cr3_phys[MAX_VIRT_CPUS];
+ unsigned long *cr3_virt[MAX_VIRT_CPUS];
+ unsigned long pde_phys[MAX_VIRT_CPUS];
+ unsigned long *pde_virt[MAX_VIRT_CPUS];
+ unsigned long page_phys[MAX_VIRT_CPUS];
+ unsigned long *page_virt[MAX_VIRT_CPUS];
+ int page_perm[MAX_VIRT_CPUS];
+} domain_context_t, *domain_context_p;
+
+static domain_context_t domain_context_list;
+
+/* initialization */
+
+static boolean xc_debug_initialized = false;
+
+static __inline__ void
+xc_debug_initialize()
+{
+ if ( !xc_debug_initialized )
+ {
+ memset((void *) &domain_context_list, 0, sizeof(domain_context_t));
+ INIT_LIST_HEAD(&domain_context_list.list);
+
+ memset((void *) &bwcpoint_list, 0, sizeof(bwcpoint_t));
+ INIT_LIST_HEAD(&bwcpoint_list.list);
+
+ xc_debug_initialized = true;
+ }
+}
+
+/**************/
+
+static domain_context_p
+xc_debug_domain_context_search (u32 domid)
+{
+ struct list_head *entry;
+ domain_context_p ctxt;
+
+ list_for_each(entry, &domain_context_list.list)
+ {
+ ctxt = list_entry(entry, domain_context_t, list);
+ if ( domid == ctxt->domid )
+ return ctxt;
+ }
+ return (domain_context_p)NULL;
+}
+
+static __inline__ domain_context_p
+xc_debug_get_context (int xc_handle, u32 domid, u32 vcpu)
+{
+ int rc;
+ domain_context_p ctxt;
+
+ xc_debug_initialize();
+
+ if ( (ctxt = xc_debug_domain_context_search(domid)) == NULL)
+ return NULL;
+
+ if ( !ctxt->valid[vcpu] )
+ {
+ if ( (rc = xc_domain_get_vcpu_context(xc_handle, domid, vcpu,
+ &ctxt->context[vcpu])) )
+ return NULL;
+
+ ctxt->valid[vcpu] = true;
+ }
+
+ return ctxt;
+}
+
+static __inline__ int
+xc_debug_set_context (int xc_handle, domain_context_p ctxt, u32 vcpu)
+{
+ dom0_op_t op;
+ int rc;
+
+ if ( !ctxt->valid[vcpu] )
+ return -EINVAL;
+
+ op.interface_version = DOM0_INTERFACE_VERSION;
+ op.cmd = DOM0_SETDOMAININFO;
+ op.u.setdomaininfo.domain = ctxt->domid;
+ op.u.setdomaininfo.vcpu = vcpu;
+ op.u.setdomaininfo.ctxt = &ctxt->context[vcpu];
+
+ if ( (rc = mlock(&ctxt->context[vcpu], sizeof(vcpu_guest_context_t))) )
+ return rc;
+
+ rc = do_dom0_op(xc_handle, &op);
+ (void) munlock(&ctxt->context[vcpu], sizeof(vcpu_guest_context_t));
+
+ return rc;
+}
+
+/**************/
+
+int
+xc_debug_attach(int xc_handle,
+ u32 domid,
+ u32 vcpu)
+{
+ domain_context_p ctxt;
+
+ xc_debug_initialize();
+
+ if ( (ctxt = malloc(sizeof(domain_context_t))) == NULL )
+ return -1;
+ memset(ctxt, 0, sizeof(domain_context_t));
+
+ ctxt->domid = domid;
+ list_add(&ctxt->list, &domain_context_list.list);
+
+ return xc_domain_pause(xc_handle, domid);
+}
+
+int
+xc_debug_detach(int xc_handle,
+ u32 domid,
+ u32 vcpu)
+{
+ domain_context_p ctxt;
+
+ xc_debug_initialize();
+
+ if ( (ctxt = xc_debug_domain_context_search (domid)) == NULL)
+ return -EINVAL;
+
+ list_del(&ctxt->list);
+
+ if ( ctxt->page_array ) free(ctxt->page_array);
+
+ free(ctxt);
+
+ return xc_domain_unpause(xc_handle, domid);
+}
+
+int
+xc_debug_read_registers(int xc_handle,
+ u32 domid,
+ u32 vcpu,
+ cpu_user_regs_t **regs)
+{
+ domain_context_p ctxt;
+ int rc = -1;
+
+ xc_debug_initialize();
+
+ ctxt = xc_debug_get_context(xc_handle, domid, vcpu);
+ if (ctxt)
+ {
+ *regs = &ctxt->context[vcpu].user_regs;
+ rc = 0;
+ }
+
+ return rc;
+}
+
+int
+xc_debug_read_fpregisters (int xc_handle,
+ u32 domid,
+ u32 vcpu,
+ char **regs)
+{
+ domain_context_p ctxt;
+ int rc = -1;
+
+ xc_debug_initialize();
+
+ ctxt = xc_debug_get_context(xc_handle, domid, vcpu);
+ if (ctxt)
+ {
+ *regs = ctxt->context[vcpu].fpu_ctxt.x;
+ rc = 0;
+ }
+
+ return rc;
+}
+
+int
+xc_debug_write_registers(int xc_handle,
+ u32 domid,
+ u32 vcpu,
+ cpu_user_regs_t *regs)
+{
+ domain_context_p ctxt;
+ int rc = -1;
+
+ xc_debug_initialize();
+
+ ctxt = xc_debug_get_context(xc_handle, domid, vcpu);
+ if (ctxt)
+ {
+ memcpy(&ctxt->context[vcpu].user_regs, regs, sizeof(cpu_user_regs_t));
+ rc = xc_debug_set_context(xc_handle, ctxt, vcpu);
+ }
+
+ return rc;
+}
+
+int
+xc_debug_step(int xc_handle,
+ u32 domid,
+ u32 vcpu)
+{
+ domain_context_p ctxt;
+ int rc;
+
+ xc_debug_initialize();
+
+ ctxt = xc_debug_get_context(xc_handle, domid, vcpu);
+ if (!ctxt) return -EINVAL;
+
+ ctxt->context[vcpu].user_regs.eflags |= X86_EFLAGS_TF;
+
+ if ( (rc = xc_debug_set_context(xc_handle, ctxt, vcpu)) )
+ return rc;
+
+ ctxt->valid[vcpu] = false;
+ return xc_domain_unpause(xc_handle, domid);
+}
+
+int
+xc_debug_continue(int xc_handle,
+ u32 domid,
+ u32 vcpu)
+{
+ domain_context_p ctxt;
+ int rc;
+
+ xc_debug_initialize();
+
+ ctxt = xc_debug_get_context(xc_handle, domid, vcpu);
+ if (!ctxt) return -EINVAL;
+
+ if ( ctxt->context[vcpu].user_regs.eflags & X86_EFLAGS_TF )
+ {
+ ctxt->context[vcpu].user_regs.eflags &= ~X86_EFLAGS_TF;
+ if ( (rc = xc_debug_set_context(xc_handle, ctxt, vcpu)) )
+ return rc;
+ }
+ ctxt->valid[vcpu] = false;
+ return xc_domain_unpause(xc_handle, domid);
+}
+
+/*************************************************/
+
+#define vtopdi(va) ((va) >> L2_PAGETABLE_SHIFT)
+#define vtopti(va) (((va) >> PAGE_SHIFT) & 0x3ff)
+
+/* access to one page */
+static int
+xc_debug_memory_page (domain_context_p ctxt, int xc_handle, u32 vcpu,
+ int protection, memory_t address, int length, u8 *buffer)
+{
+ vcpu_guest_context_t *vcpu_ctxt = &ctxt->context[vcpu];
+ unsigned long pde, page;
+ unsigned long va = (unsigned long)address;
+ void *ptr;
+ long pages;
+
+ pages = xc_get_tot_pages(xc_handle, ctxt->domid);
+
+ if ( ctxt->total_pages != pages )
+ {
+ if ( ctxt->total_pages > 0 ) free( ctxt->page_array );
+ ctxt->total_pages = pages;
+
+ ctxt->page_array = malloc(pages * sizeof(unsigned long));
+ if ( ctxt->page_array == NULL )
+ {
+ printf("Could not allocate memory\n");
+ return 0;
+ }
+
+ if ( xc_get_pfn_list(xc_handle, ctxt->domid, ctxt->page_array,pages) !=
+ pages )
+ {
+ printf("Could not get the page frame list\n");
+ return 0;
+ }
+ }
+
+ if ( vcpu_ctxt->pt_base != ctxt->cr3_phys[vcpu])
+ {
+ ctxt->cr3_phys[vcpu] = vcpu_ctxt->pt_base;
+ if ( ctxt->cr3_virt[vcpu] )
+ munmap(ctxt->cr3_virt[vcpu], PAGE_SIZE);
+ ctxt->cr3_virt[vcpu] = xc_map_foreign_range(xc_handle, ctxt->domid,
+ PAGE_SIZE, PROT_READ, ctxt->cr3_phys[vcpu] >> PAGE_SHIFT);
+ if ( ctxt->cr3_virt[vcpu] == NULL )
+ return 0;
+ }
+
+
+ if ( (pde = ctxt->cr3_virt[vcpu][vtopdi(va)]) == 0) /* logical address */
+ return 0;
+ if (ctxt->context[vcpu].flags & VGCF_VMX_GUEST)
+ pde = ctxt->page_array[pde >> PAGE_SHIFT] << PAGE_SHIFT;
+ if (pde != ctxt->pde_phys[vcpu])
+ {
+ ctxt->pde_phys[vcpu] = pde;
+ if ( ctxt->pde_virt[vcpu])
+ munmap(ctxt->pde_virt[vcpu], PAGE_SIZE);
+ ctxt->pde_virt[vcpu] = xc_map_foreign_range(xc_handle, ctxt->domid,
+ PAGE_SIZE, PROT_READ, ctxt->pde_phys[vcpu] >> PAGE_SHIFT);
+ if ( ctxt->pde_virt[vcpu] == NULL )
+ return 0;
+ }
+
+ if ((page = ctxt->pde_virt[vcpu][vtopti(va)]) == 0) /* logical address */
+ return 0;
+ if (ctxt->context[vcpu].flags & VGCF_VMX_GUEST)
+ page = ctxt->page_array[page >> PAGE_SHIFT] << PAGE_SHIFT;
+ if (page != ctxt->page_phys[vcpu] || protection != ctxt->page_perm[vcpu])
+ {
+ ctxt->page_phys[vcpu] = page;
+ if (ctxt->page_virt[vcpu])
+ munmap(ctxt->page_virt[vcpu], PAGE_SIZE);
+ ctxt->page_virt[vcpu] = xc_map_foreign_range(xc_handle, ctxt->domid,
+ PAGE_SIZE, protection, ctxt->page_phys[vcpu] >> PAGE_SHIFT);
+ if ( ctxt->page_virt[vcpu] == NULL )
+ {
+ printf("cr3 %lx pde %lx page %lx pti %lx\n",
+ vcpu_ctxt->pt_base, pde, page, vtopti(va));
+ ctxt->page_phys[vcpu] = 0;
+ return 0;
+ }
+ ctxt->page_perm[vcpu] = protection;
+ }
+
+ ptr = (void *)( (unsigned long)ctxt->page_virt[vcpu] |
+ (va & ~PAGE_MASK) );
+
+ if ( protection & PROT_WRITE )
+ {
+ memcpy(ptr, buffer, length);
+ }
+ else
+ {
+ memcpy(buffer, ptr, length);
+ }
+
+ return length;
+}
+
+/* divide a memory operation into accesses to individual pages */
+static int
+xc_debug_memory_op (domain_context_p ctxt, int xc_handle, u32 vcpu,
+ int protection, memory_t address, int length, u8 *buffer)
+{
+ int remain; /* number of bytes to touch past this page */
+ int bytes = 0;
+
+ while ( (remain = (address + length - 1) - (address | (PAGE_SIZE-1))) > 0)
+ {
+ bytes += xc_debug_memory_page(ctxt, xc_handle, vcpu, protection,
+ address, length - remain, buffer);
+ buffer += (length - remain);
+ length = remain;
+ address = (address | (PAGE_SIZE - 1)) + 1;
+ }
+
+ bytes += xc_debug_memory_page(ctxt, xc_handle, vcpu, protection,
+ address, length, buffer);
+
+ return bytes;
+}
+
+int
+xc_debug_read_memory(int xc_handle,
+ u32 domid,
+ u32 vcpu,
+ memory_t address,
+ u32 length,
+ u8 *data)
+{
+ domain_context_p ctxt;
+
+ xc_debug_initialize();
+
+ ctxt = xc_debug_get_context(xc_handle, domid, vcpu);
+
+ xc_debug_memory_op(ctxt, xc_handle, vcpu, PROT_READ,
+ address, length, data);
+
+ return 0;
+}
+
+int
+xc_debug_write_memory(int xc_handle,
+ u32 domid,
+ u32 vcpu,
+ memory_t address,
+ u32 length,
+ u8 *data)
+{
+ domain_context_p ctxt;
+
+ xc_debug_initialize();
+
+ ctxt = xc_debug_get_context(xc_handle, domid, vcpu);
+ xc_debug_memory_op(ctxt, xc_handle, vcpu, PROT_READ | PROT_WRITE,
+
+ address, length, data);
+
+ return 0;
+}
+
+int
+xc_debug_insert_memory_breakpoint(int xc_handle,
+ u32 domid,
+ u32 vcpu,
+ memory_t address,
+ u32 length)
+{
+ bwcpoint_p bkpt;
+ u8 breakpoint_opcode = 0xcc;
+
+ printf("insert breakpoint %d:%lx %d\n",
+ domid, address, length);
+
+ xc_debug_initialize();
+
+ bkpt = malloc(sizeof(bwcpoint_t));
+ if ( bkpt == NULL )
+ {
+ printf("error: breakpoint length should be 1\n");
+ return -1;
+ }
+
+ if ( length != 1 )
+ {
+ printf("error: breakpoint length should be 1\n");
+ free(bkpt);
+ return -1;
+ }
+
+ bkpt->address = address;
+ bkpt->domain = domid;
+
+ xc_debug_read_memory(xc_handle, domid, vcpu, address, 1,
+ &bkpt->old_value);
+
+ xc_debug_write_memory(xc_handle, domid, vcpu, address, 1,
+ &breakpoint_opcode);
+
+ list_add(&bkpt->list, &bwcpoint_list.list);
+
+ printf("breakpoint_set %d:%lx 0x%x\n",
+ domid, address, bkpt->old_value);
+
+ return 0;
+}
+
+int
+xc_debug_remove_memory_breakpoint(int xc_handle,
+ u32 domid,
+ u32 vcpu,
+ memory_t address,
+ u32 length)
+{
+ bwcpoint_p bkpt = NULL;
+
+ printf ("remove breakpoint %d:%lx\n",
+ domid, address);
+
+ struct list_head *entry;
+ list_for_each(entry, &bwcpoint_list.list)
+ {
+ bkpt = list_entry(entry, bwcpoint_t, list);
+ if ( domid == bkpt->domain && address == bkpt->address )
+ break;
+ }
+
+ if (bkpt == &bwcpoint_list || bkpt == NULL)
+ {
+ printf ("error: no breakpoint found\n");
+ return -1;
+ }
+
+ list_del(&bkpt->list);
+
+ xc_debug_write_memory(xc_handle, domid, vcpu, address, 1,
+ &bkpt->old_value);
+
+ free(bkpt);
+ return 0;
+}
+
+int
+xc_debug_query_domain_stop(int xc_handle, int *dom_list, int dom_list_size)
+{
+ xc_dominfo_t *info;
+ u32 first_dom = 0;
+ int max_doms = 1024;
+ int nr_doms, loop;
+ int count = 0;
+
+ if ( (info = malloc(max_doms * sizeof(xc_dominfo_t))) == NULL )
+ return -ENOMEM;
+
+ nr_doms = xc_domain_getinfo(xc_handle, first_dom, max_doms, info);
+
+ for (loop = 0; loop < nr_doms; loop++)
+ {
+ printf ("domid: %d", info[loop].domid);
+ printf (" %c%c%c%c%c%c",
+ info[loop].dying ? 'D' : '-',
+ info[loop].crashed ? 'C' : '-',
+ info[loop].shutdown ? 'S' : '-',
+ info[loop].paused ? 'P' : '-',
+ info[loop].blocked ? 'B' : '-',
+ info[loop].running ? 'R' : '-');
+ printf (" pages: %ld, vcpus %d",
+ info[loop].nr_pages, info[loop].vcpus);
+ printf ("\n");
+
+ if ( info[loop].paused && count < dom_list_size)
+ {
+ dom_list[count++] = info[loop].domid;
+ }
+ }
+
+ free(info);
+
+ return count;
+}
+
+/*
+ * Local variables:
+ * mode: C
+ * c-set-style: "BSD"
+ * c-basic-offset: 4
+ * tab-width: 4
+ * indent-tabs-mode: nil
+ * End:
+ */
--- /dev/null
+/*
+ * xc_debug.h
+ *
+ * alex ho
+ * http://www.cl.cam.ac.uk/netos/pdb
+ *
+ */
+
+#ifndef _XC_DEBUG_H_DEFINED
+#define _XC_DEBUG_H_DEFINED
+
+int xc_debug_attach(int xc_handle,
+ u32 domid,
+ u32 vcpu);
+
+int xc_debug_detach(int xc_handle,
+ u32 domid,
+ u32 vcpu);
+
+int xc_debug_read_registers(int xc_handle,
+ u32 domid,
+ u32 vcpu,
+ cpu_user_regs_t **regs);
+
+int xc_debug_read_fpregisters (int xc_handle,
+ u32 domid,
+ u32 vcpu,
+ char **regs);
+
+int xc_debug_write_registers(int xc_handle,
+ u32 domid,
+ u32 vcpu,
+ cpu_user_regs_t *regs);
+
+int xc_debug_step(int xc_handle,
+ u32 domid,
+ u32 vcpu);
+
+int xc_debug_continue(int xc_handle,
+ u32 domid,
+ u32 vcpu);
+
+int xc_debug_read_memory(int xc_handle,
+ u32 domid,
+ u32 vcpu,
+ memory_t address,
+ u32 length,
+ u8 *data);
+
+
+int xc_debug_write_memory(int xc_handle,
+ u32 domid,
+ u32 vcpu,
+ memory_t address,
+ u32 length,
+ u8 *data);
+
+
+int xc_debug_insert_memory_breakpoint(int xc_handle,
+ u32 domid,
+ u32 vcpu,
+ memory_t address,
+ u32 length);
+
+int xc_debug_remove_memory_breakpoint(int xc_handle,
+ u32 domid,
+ u32 vcpu,
+ memory_t address,
+ u32 length);
+
+int xc_debug_query_domain_stop(int xc_handle,
+ int *dom_list,
+ int dom_list_size);
+
+
+#endif /* _XC_DEBUG_H_DEFINED */
--- /dev/null
+(** Domain.ml
+ *
+ * domain context implementation
+ *
+ * @author copyright (c) 2005 alex ho
+ * @see <www.cl.cam.ac.uk/netos/pdb> pervasive debugger
+ * @version 1
+ *)
+
+open Int32
+open Intel
+
+type context_t =
+{
+ mutable domain : int;
+ mutable execution_domain : int
+}
+
+let default_context = { domain = 0; execution_domain = 0 }
+
+let new_context dom exec_dom = {domain = dom; execution_domain = exec_dom}
+
+let set_domain ctx value =
+ ctx.domain <- value;
+ print_endline (Printf.sprintf "ctx.domain <- %d" ctx.domain)
+
+let set_execution_domain ctx value =
+ ctx.execution_domain <- value;
+ print_endline (Printf.sprintf "ctx.execution_domain <- %d"
+ ctx.execution_domain)
+
+let get_domain ctx =
+ ctx.domain
+
+let get_execution_domain ctx =
+ ctx.execution_domain
+
+let string_of_context ctx =
+ Printf.sprintf "{domain} domain: %d, execution_domain: %d"
+ ctx.domain ctx.execution_domain
+
+external read_registers : context_t -> registers = "read_registers"
+external write_register : context_t -> register -> int32 -> unit =
+ "write_register"
+external read_memory : context_t -> int32 -> int -> int list =
+ "read_memory"
+external write_memory : context_t -> int32 -> int list -> unit =
+ "write_memory"
+
+external continue : context_t -> unit = "continue_target"
+external step : context_t -> unit = "step_target"
+
+external insert_memory_breakpoint : context_t -> int32 -> int -> unit =
+ "insert_memory_breakpoint"
+external remove_memory_breakpoint : context_t -> int32 -> int -> unit =
+ "remove_memory_breakpoint"
+
+external attach_debugger : int -> int -> unit = "attach_debugger"
+external detach_debugger : int -> int -> unit = "detach_debugger"
+external pause_target : int -> unit = "pause_target"
+
+let pause ctx =
+ pause_target ctx.domain
--- /dev/null
+(** Domain.mli
+ *
+ * domain context interface
+ *
+ * @author copyright (c) 2005 alex ho
+ * @see <www.cl.cam.ac.uk/netos/pdb> pervasive debugger
+ * @version 1
+ *)
+
+open Int32
+open Intel
+
+type context_t
+
+val default_context : context_t
+val new_context : int -> int -> context_t
+
+val set_domain : context_t -> int -> unit
+val get_domain : context_t -> int
+val set_execution_domain : context_t -> int -> unit
+val get_execution_domain : context_t -> int
+
+val string_of_context : context_t -> string
+
+val read_registers : context_t -> registers
+val write_register : context_t -> register -> int32 -> unit
+val read_memory : context_t -> int32 -> int -> int list
+val write_memory : context_t -> int32 -> int list -> unit
+
+val continue : context_t -> unit
+val step : context_t -> unit
+
+val insert_memory_breakpoint : context_t -> int32 -> int -> unit
+val remove_memory_breakpoint : context_t -> int32 -> int -> unit
+
+val attach_debugger : int -> int -> unit
+val detach_debugger : int -> int -> unit
+val pause : context_t -> unit
--- /dev/null
+(** Intel.ml
+ *
+ * various sundry Intel x86 definitions
+ *
+ * @author copyright (c) 2005 alex ho
+ * @see <www.cl.cam.ac.uk/netos/pdb> pervasive debugger
+ * @version 1
+ *)
+
+
+type register =
+ | EBX
+ | ECX
+ | EDX
+ | ESI
+ | EDI
+ | EBP
+ | EAX
+ | Error_code
+ | Entry_vector
+ | EIP
+ | CS
+ | EFLAGS
+ | ESP
+ | SS
+ | ES
+ | DS
+ | FS
+ | GS
+
+type registers =
+ { ebx : int32;
+ ecx : int32;
+ edx : int32;
+ esi : int32;
+ edi : int32;
+ ebp : int32;
+ eax : int32;
+ error_code : int32;
+ entry_vector : int32;
+ eip : int32;
+ cs : int32;
+ eflags : int32;
+ esp : int32;
+ ss : int32;
+ es : int32;
+ ds : int32;
+ fs : int32;
+ gs : int32
+ }
+
+let null_registers =
+ { ebx = 0l;
+ ecx = 0l;
+ edx = 0l;
+ esi = 0l;
+ edi = 0l;
+ ebp = 0l;
+ eax = 0l;
+ error_code = 0l;
+ entry_vector = 0l;
+ eip = 0l;
+ cs = 0l;
+ eflags = 0l;
+ esp = 0l;
+ ss = 0l;
+ es = 0l;
+ ds = 0l;
+ fs = 0l;
+ gs = 0l
+ }
--- /dev/null
+OCAMLMAKEFILE = OCamlMakefile
+
+XEN_ROOT = ../..
+include $(XEN_ROOT)/tools/Rules.mk
+
+# overwrite LDFLAGS from xen/tool/Rules.mk
+# otherwise, ocamlmktop gets confused.
+LDFLAGS =
+
+OCAML_ROOT=/usr/local
+# force ocaml 3.08
+# OCAML_ROOT = /anfs/nos1/ach61/ocaml
+
+OCAMLC = $(OCAML_ROOT)/bin/ocamlc
+OCAMLMKTOP = $(OCAML_ROOT)/bin/ocamlmktop
+OCAMLLIBPATH= $(OCAML_ROOT)/lib/ocaml
+
+INCLUDES += -I $(XEN_XC)
+INCLUDES += -I $(XEN_LIBXC)
+INCLUDES += -I $(OCAML_ROOT)/lib/ocaml
+
+CFLAGS += $(INCLUDES)
+CFLAGS += -Wall
+CFLAGS += -Werror
+CFLAGS += -g
+
+CLIBS += xc
+CLIBS += xutil
+CLIBS += pdb
+
+LIBDIRS += $(XEN_LIBXC)
+LIBDIRS += $(XEN_LIBXUTIL)
+LIBDIRS += .
+
+LIBS += unix str
+
+PRE_TARGETS = libpdb.a
+
+all : bc
+
+libpdb.a : pdb_xen.o
+ ar rc $@ $^
+ ranlib $@
+
+SOURCES += pdb_caml_xc.c pdb_xen.c
+SOURCES += Util.ml Intel.ml
+SOURCES += evtchn.ml evtchn.mli
+SOURCES += Domain.ml Process.ml
+SOURCES += Domain.mli Process.mli
+SOURCES += PDB.ml debugger.ml server.ml
+RESULT = pdb
+
+include $(OCAMLMAKEFILE)
+
--- /dev/null
+###########################################################################
+# OCamlMakefile
+# Copyright (C) 1999-2004 Markus Mottl
+#
+# For updates see:
+# http://www.oefai.at/~markus/ocaml_sources
+#
+# $Id: OCamlMakefile,v 1.1 2005/05/19 09:30:48 root Exp $
+#
+###########################################################################
+
+# Modified by damien for .glade.ml compilation
+
+# Set these variables to the names of the sources to be processed and
+# the result variable. Order matters during linkage!
+
+ifndef SOURCES
+ SOURCES := foo.ml
+endif
+export SOURCES
+
+ifndef RES_CLIB_SUF
+ RES_CLIB_SUF := _stubs
+endif
+export RES_CLIB_SUF
+
+ifndef RESULT
+ RESULT := foo
+endif
+export RESULT
+
+export LIB_PACK_NAME
+
+ifndef DOC_FILES
+ DOC_FILES := $(filter %.mli, $(SOURCES))
+endif
+export DOC_FILES
+
+export BCSUFFIX
+export NCSUFFIX
+
+ifndef TOPSUFFIX
+ TOPSUFFIX := .top
+endif
+export TOPSUFFIX
+
+# Eventually set include- and library-paths, libraries to link,
+# additional compilation-, link- and ocamlyacc-flags
+# Path- and library information needs not be written with "-I" and such...
+# Define THREADS if you need it, otherwise leave it unset (same for
+# USE_CAMLP4)!
+
+export THREADS
+export VMTHREADS
+export ANNOTATE
+export USE_CAMLP4
+
+export INCDIRS
+export LIBDIRS
+export EXTLIBDIRS
+export RESULTDEPS
+export OCAML_DEFAULT_DIRS
+
+export LIBS
+export CLIBS
+
+export OCAMLFLAGS
+export OCAMLNCFLAGS
+export OCAMLBCFLAGS
+
+export OCAMLLDFLAGS
+export OCAMLNLDFLAGS
+export OCAMLBLDFLAGS
+
+ifndef OCAMLCPFLAGS
+ OCAMLCPFLAGS := a
+endif
+
+export OCAMLCPFLAGS
+
+export PPFLAGS
+
+export YFLAGS
+export IDLFLAGS
+
+export OCAMLDOCFLAGS
+
+export OCAMLFIND_INSTFLAGS
+
+export DVIPSFLAGS
+
+export STATIC
+
+# Add a list of optional trash files that should be deleted by "make clean"
+export TRASH
+
+#################### variables depending on your OCaml-installation
+
+ifdef MINGW
+ export MINGW
+ WIN32 := 1
+ CFLAGS_WIN32 := -mno-cygwin
+endif
+ifdef MSVC
+ export MSVC
+ WIN32 := 1
+ ifndef STATIC
+ CPPFLAGS_WIN32 := -DCAML_DLL
+ endif
+ CFLAGS_WIN32 += -nologo
+ EXT_OBJ := obj
+ EXT_LIB := lib
+ ifeq ($(CC),gcc)
+ # work around GNU Make default value
+ ifdef THREADS
+ CC := cl -MT
+ else
+ CC := cl
+ endif
+ endif
+ ifeq ($(CXX),g++)
+ # work around GNU Make default value
+ CXX := $(CC)
+ endif
+ CFLAG_O := -Fo
+endif
+ifdef WIN32
+ EXT_CXX := cpp
+ EXE := .exe
+endif
+
+ifndef EXT_OBJ
+ EXT_OBJ := o
+endif
+ifndef EXT_LIB
+ EXT_LIB := a
+endif
+ifndef EXT_CXX
+ EXT_CXX := cc
+endif
+ifndef EXE
+ EXE := # empty
+endif
+ifndef CFLAG_O
+ CFLAG_O := -o # do not delete this comment (preserves trailing whitespace)!
+endif
+
+export CC
+export CXX
+export CFLAGS
+export CXXFLAGS
+export LDFLAGS
+export CPPFLAGS
+
+ifndef RPATH_FLAG
+ RPATH_FLAG := -R
+endif
+export RPATH_FLAG
+
+ifndef MSVC
+ifndef PIC_CFLAGS
+ PIC_CFLAGS := -fPIC
+endif
+ifndef PIC_CPPFLAGS
+ PIC_CPPFLAGS := -DPIC
+endif
+endif
+
+export PIC_CFLAGS
+export PIC_CPPFLAGS
+
+BCRESULT := $(addsuffix $(BCSUFFIX), $(RESULT))
+NCRESULT := $(addsuffix $(NCSUFFIX), $(RESULT))
+TOPRESULT := $(addsuffix $(TOPSUFFIX), $(RESULT))
+
+ifndef OCAMLFIND
+ OCAMLFIND := ocamlfind
+endif
+export OCAMLFIND
+
+ifndef OCAMLC
+ OCAMLC := ocamlc
+endif
+export OCAMLC
+
+ifndef OCAMLOPT
+ OCAMLOPT := ocamlopt
+endif
+export OCAMLOPT
+
+ifndef OCAMLMKTOP
+ OCAMLMKTOP := ocamlmktop
+endif
+export OCAMLMKTOP
+
+ifndef OCAMLCP
+ OCAMLCP := ocamlcp
+endif
+export OCAMLCP
+
+ifndef OCAMLDEP
+ OCAMLDEP := ocamldep
+endif
+export OCAMLDEP
+
+ifndef OCAMLLEX
+ OCAMLLEX := ocamllex
+endif
+export OCAMLLEX
+
+ifndef OCAMLYACC
+ OCAMLYACC := ocamlyacc
+endif
+export OCAMLYACC
+
+ifndef OCAMLMKLIB
+ OCAMLMKLIB := ocamlmklib
+endif
+export OCAMLMKLIB
+
+ifndef OCAML_GLADECC
+ OCAML_GLADECC := lablgladecc2
+endif
+export OCAML_GLADECC
+
+ifndef OCAML_GLADECC_FLAGS
+ OCAML_GLADECC_FLAGS :=
+endif
+export OCAML_GLADECC_FLAGS
+
+ifndef CAMELEON_REPORT
+ CAMELEON_REPORT := report
+endif
+export CAMELEON_REPORT
+
+ifndef CAMELEON_REPORT_FLAGS
+ CAMELEON_REPORT_FLAGS :=
+endif
+export CAMELEON_REPORT_FLAGS
+
+ifndef CAMELEON_ZOGGY
+ CAMELEON_ZOGGY := camlp4o pa_zog.cma pr_o.cmo
+endif
+export CAMELEON_ZOGGY
+
+ifndef CAMELEON_ZOGGY_FLAGS
+ CAMELEON_ZOGGY_FLAGS :=
+endif
+export CAMELEON_ZOGGY_FLAGS
+
+ifndef OXRIDL
+ OXRIDL := oxridl
+endif
+export OXRIDL
+
+ifndef CAMLIDL
+ CAMLIDL := camlidl
+endif
+export CAMLIDL
+
+ifndef CAMLIDLDLL
+ CAMLIDLDLL := camlidldll
+endif
+export CAMLIDLDLL
+
+ifndef NOIDLHEADER
+ MAYBE_IDL_HEADER := -header
+endif
+export NOIDLHEADER
+
+export NO_CUSTOM
+
+ifndef CAMLP4
+ CAMLP4 := camlp4
+endif
+export CAMLP4
+
+ifndef REAL_OCAMLFIND
+ ifdef PACKS
+ ifndef CREATE_LIB
+ ifdef THREADS
+ PACKS += threads
+ endif
+ endif
+ empty :=
+ space := $(empty) $(empty)
+ comma := ,
+ ifdef PREDS
+ PRE_OCAML_FIND_PREDICATES := $(subst $(space),$(comma),$(PREDS))
+ PRE_OCAML_FIND_PACKAGES := $(subst $(space),$(comma),$(PACKS))
+ OCAML_FIND_PREDICATES := -predicates $(PRE_OCAML_FIND_PREDICATES)
+ # OCAML_DEP_PREDICATES := -syntax $(PRE_OCAML_FIND_PREDICATES)
+ OCAML_FIND_PACKAGES := $(OCAML_FIND_PREDICATES) -package $(PRE_OCAML_FIND_PACKAGES)
+ OCAML_DEP_PACKAGES := $(OCAML_DEP_PREDICATES) -package $(PRE_OCAML_FIND_PACKAGES)
+ else
+ OCAML_FIND_PACKAGES := -package $(subst $(space),$(comma),$(PACKS))
+ OCAML_DEP_PACKAGES :=
+ endif
+ OCAML_FIND_LINKPKG := -linkpkg
+ REAL_OCAMLFIND := $(OCAMLFIND)
+ endif
+endif
+
+export OCAML_FIND_PACKAGES
+export OCAML_DEP_PACKAGES
+export OCAML_FIND_LINKPKG
+export REAL_OCAMLFIND
+
+ifndef OCAMLDOC
+ OCAMLDOC := ocamldoc
+endif
+export OCAMLDOC
+
+ifndef LATEX
+ LATEX := latex
+endif
+export LATEX
+
+ifndef DVIPS
+ DVIPS := dvips
+endif
+export DVIPS
+
+ifndef PS2PDF
+ PS2PDF := ps2pdf
+endif
+export PS2PDF
+
+ifndef OCAMLMAKEFILE
+ OCAMLMAKEFILE := OCamlMakefile
+endif
+export OCAMLMAKEFILE
+
+ifndef OCAMLLIBPATH
+ OCAMLLIBPATH := \
+ $(shell $(OCAMLC) 2>/dev/null -where || echo /usr/local/lib/ocaml)
+endif
+export OCAMLLIBPATH
+
+ifndef OCAML_LIB_INSTALL
+ OCAML_LIB_INSTALL := $(OCAMLLIBPATH)/contrib
+endif
+export OCAML_LIB_INSTALL
+
+###########################################################################
+
+#################### change following sections only if
+#################### you know what you are doing!
+
+# delete target files when a build command fails
+.PHONY: .DELETE_ON_ERROR
+.DELETE_ON_ERROR:
+
+# for pedants using "--warn-undefined-variables"
+export MAYBE_IDL
+export REAL_RESULT
+export CAMLIDLFLAGS
+export THREAD_FLAG
+export RES_CLIB
+export MAKEDLL
+export ANNOT_FLAG
+export C_OXRIDL
+export SUBPROJS
+export CFLAGS_WIN32
+export CPPFLAGS_WIN32
+
+INCFLAGS :=
+
+SHELL := /bin/sh
+
+MLDEPDIR := ._d
+BCDIDIR := ._bcdi
+NCDIDIR := ._ncdi
+
+FILTER_EXTNS := %.mli %.ml %.mll %.mly %.idl %.oxridl %.c %.$(EXT_CXX) %.rep %.zog %.glade
+
+FILTERED := $(filter $(FILTER_EXTNS), $(SOURCES))
+SOURCE_DIRS := $(filter-out ./, $(sort $(dir $(FILTERED))))
+
+FILTERED_REP := $(filter %.rep, $(FILTERED))
+DEP_REP := $(FILTERED_REP:%.rep=$(MLDEPDIR)/%.d)
+AUTO_REP := $(FILTERED_REP:.rep=.ml)
+
+FILTERED_ZOG := $(filter %.zog, $(FILTERED))
+DEP_ZOG := $(FILTERED_ZOG:%.zog=$(MLDEPDIR)/%.d)
+AUTO_ZOG := $(FILTERED_ZOG:.zog=.ml)
+
+FILTERED_GLADE := $(filter %.glade, $(FILTERED))
+DEP_GLADE := $(FILTERED_GLADE:%.glade=$(MLDEPDIR)/%.d)
+AUTO_GLADE := $(FILTERED_GLADE:.glade=.ml)
+
+FILTERED_ML := $(filter %.ml, $(FILTERED))
+DEP_ML := $(FILTERED_ML:%.ml=$(MLDEPDIR)/%.d)
+
+FILTERED_MLI := $(filter %.mli, $(FILTERED))
+DEP_MLI := $(FILTERED_MLI:.mli=.di)
+
+FILTERED_MLL := $(filter %.mll, $(FILTERED))
+DEP_MLL := $(FILTERED_MLL:%.mll=$(MLDEPDIR)/%.d)
+AUTO_MLL := $(FILTERED_MLL:.mll=.ml)
+
+FILTERED_MLY := $(filter %.mly, $(FILTERED))
+DEP_MLY := $(FILTERED_MLY:%.mly=$(MLDEPDIR)/%.d) $(FILTERED_MLY:.mly=.di)
+AUTO_MLY := $(FILTERED_MLY:.mly=.mli) $(FILTERED_MLY:.mly=.ml)
+
+FILTERED_IDL := $(filter %.idl, $(FILTERED))
+DEP_IDL := $(FILTERED_IDL:%.idl=$(MLDEPDIR)/%.d) $(FILTERED_IDL:.idl=.di)
+C_IDL := $(FILTERED_IDL:%.idl=%_stubs.c)
+ifndef NOIDLHEADER
+ C_IDL += $(FILTERED_IDL:.idl=.h)
+endif
+OBJ_C_IDL := $(FILTERED_IDL:%.idl=%_stubs.$(EXT_OBJ))
+AUTO_IDL := $(FILTERED_IDL:.idl=.mli) $(FILTERED_IDL:.idl=.ml) $(C_IDL)
+
+FILTERED_OXRIDL := $(filter %.oxridl, $(FILTERED))
+DEP_OXRIDL := $(FILTERED_OXRIDL:%.oxridl=$(MLDEPDIR)/%.d) $(FILTERED_OXRIDL:.oxridl=.di)
+AUTO_OXRIDL := $(FILTERED_OXRIDL:.oxridl=.mli) $(FILTERED_OXRIDL:.oxridl=.ml) $(C_OXRIDL)
+
+FILTERED_C_CXX := $(filter %.c %.$(EXT_CXX), $(FILTERED))
+OBJ_C_CXX := $(FILTERED_C_CXX:.c=.$(EXT_OBJ))
+OBJ_C_CXX := $(OBJ_C_CXX:.$(EXT_CXX)=.$(EXT_OBJ))
+
+PRE_TARGETS += $(AUTO_MLL) $(AUTO_MLY) $(AUTO_IDL) $(AUTO_OXRIDL) $(AUTO_ZOG) $(AUTO_REP) $(AUTO_GLADE)
+
+ALL_DEPS := $(DEP_ML) $(DEP_MLI) $(DEP_MLL) $(DEP_MLY) $(DEP_IDL) $(DEP_OXRIDL) $(DEP_ZOG) $(DEP_REP) $(DEP_GLADE)
+
+MLDEPS := $(filter %.d, $(ALL_DEPS))
+MLIDEPS := $(filter %.di, $(ALL_DEPS))
+BCDEPIS := $(MLIDEPS:%.di=$(BCDIDIR)/%.di)
+NCDEPIS := $(MLIDEPS:%.di=$(NCDIDIR)/%.di)
+
+ALLML := $(filter %.mli %.ml %.mll %.mly %.idl %.oxridl %.rep %.zog %.glade, $(FILTERED))
+
+IMPLO_INTF := $(ALLML:%.mli=%.mli.__)
+IMPLO_INTF := $(foreach file, $(IMPLO_INTF), \
+ $(basename $(file)).cmi $(basename $(file)).cmo)
+IMPLO_INTF := $(filter-out %.mli.cmo, $(IMPLO_INTF))
+IMPLO_INTF := $(IMPLO_INTF:%.mli.cmi=%.cmi)
+
+IMPLX_INTF := $(IMPLO_INTF:.cmo=.cmx)
+
+INTF := $(filter %.cmi, $(IMPLO_INTF))
+IMPL_CMO := $(filter %.cmo, $(IMPLO_INTF))
+IMPL_CMX := $(IMPL_CMO:.cmo=.cmx)
+IMPL_ASM := $(IMPL_CMO:.cmo=.asm)
+IMPL_S := $(IMPL_CMO:.cmo=.s)
+
+OBJ_LINK := $(OBJ_C_IDL) $(OBJ_C_CXX)
+OBJ_FILES := $(IMPL_CMO:.cmo=.$(EXT_OBJ)) $(OBJ_LINK)
+
+EXECS := $(addsuffix $(EXE), \
+ $(sort $(TOPRESULT) $(BCRESULT) $(NCRESULT)))
+ifdef WIN32
+ EXECS += $(BCRESULT).dll $(NCRESULT).dll
+endif
+
+CLIB_BASE := $(RESULT)$(RES_CLIB_SUF)
+ifneq ($(strip $(OBJ_LINK)),)
+ RES_CLIB := lib$(CLIB_BASE).$(EXT_LIB)
+endif
+
+ifdef WIN32
+DLLSONAME := $(CLIB_BASE).dll
+else
+DLLSONAME := dll$(CLIB_BASE).so
+endif
+
+NONEXECS := $(INTF) $(IMPL_CMO) $(IMPL_CMX) $(IMPL_ASM) $(IMPL_S) \
+ $(OBJ_FILES) $(PRE_TARGETS) $(BCRESULT).cma $(NCRESULT).cmxa \
+ $(NCRESULT).$(EXT_LIB) $(BCRESULT).cmi $(BCRESULT).cmo \
+ $(NCRESULT).cmi $(NCRESULT).cmx $(NCRESULT).o \
+ $(RES_CLIB) $(IMPL_CMO:.cmo=.annot) \
+ $(LIB_PACK_NAME).cmi $(LIB_PACK_NAME).cmo $(LIB_PACK_NAME).cmx $(LIB_PACK_NAME).o
+
+ifndef STATIC
+ NONEXECS += $(DLLSONAME)
+endif
+
+ifndef LIBINSTALL_FILES
+ LIBINSTALL_FILES := $(RESULT).mli $(RESULT).cmi $(RESULT).cma \
+ $(RESULT).cmxa $(RESULT).$(EXT_LIB) $(RES_CLIB)
+ ifndef STATIC
+ ifneq ($(strip $(OBJ_LINK)),)
+ LIBINSTALL_FILES += $(DLLSONAME)
+ endif
+ endif
+endif
+
+export LIBINSTALL_FILES
+
+ifdef WIN32
+ # some extra stuff is created while linking DLLs
+ NONEXECS += $(BCRESULT).$(EXT_LIB) $(BCRESULT).exp $(NCRESULT).exp $(CLIB_BASE).exp $(CLIB_BASE).lib
+endif
+
+TARGETS := $(EXECS) $(NONEXECS)
+
+# If there are IDL-files
+ifneq ($(strip $(FILTERED_IDL)),)
+ MAYBE_IDL := -cclib -lcamlidl
+endif
+
+ifdef USE_CAMLP4
+ CAMLP4PATH := \
+ $(shell $(CAMLP4) -where 2>/dev/null || echo /usr/local/lib/camlp4)
+ INCFLAGS := -I $(CAMLP4PATH)
+ CINCFLAGS := -I$(CAMLP4PATH)
+endif
+
+DINCFLAGS := $(INCFLAGS) $(SOURCE_DIRS:%=-I %) $(OCAML_DEFAULT_DIRS:%=-I %)
+INCFLAGS := $(DINCFLAGS) $(INCDIRS:%=-I %)
+CINCFLAGS += $(SOURCE_DIRS:%=-I%) $(INCDIRS:%=-I%) $(OCAML_DEFAULT_DIRS:%=-I%)
+
+ifndef MSVC
+CLIBFLAGS += $(SOURCE_DIRS:%=-L%) $(LIBDIRS:%=-L%) \
+ $(EXTLIBDIRS:%=-L%) $(EXTLIBDIRS:%=-Wl,$(RPATH_FLAG)%) \
+ $(OCAML_DEFAULT_DIRS:%=-L%)
+endif
+
+ifndef PROFILING
+ INTF_OCAMLC := $(OCAMLC)
+else
+ ifndef THREADS
+ INTF_OCAMLC := $(OCAMLCP) -p $(OCAMLCPFLAGS)
+ else
+ # OCaml does not support profiling byte code
+ # with threads (yet), therefore we force an error.
+ ifndef REAL_OCAMLC
+ $(error Profiling of multithreaded byte code not yet supported by OCaml)
+ endif
+ INTF_OCAMLC := $(OCAMLC)
+ endif
+endif
+
+ifndef MSVC
+COMMON_LDFLAGS := $(LDFLAGS:%=-ccopt %) $(SOURCE_DIRS:%=-ccopt -L%) \
+ $(LIBDIRS:%=-ccopt -L%) $(EXTLIBDIRS:%=-ccopt -L%) \
+ $(EXTLIBDIRS:%=-ccopt -Wl,$(RPATH_FLAG)%) \
+ $(OCAML_DEFAULT_DIRS:%=-ccopt -L%)
+else
+COMMON_LDFLAGS := -ccopt "/link -NODEFAULTLIB:LIBC $(LDFLAGS:%=%) $(SOURCE_DIRS:%=-LIBPATH:%) \
+ $(LIBDIRS:%=-LIBPATH:%) $(EXTLIBDIRS:%=-LIBPATH:%) \
+ $(OCAML_DEFAULT_DIRS:%=-LIBPATH:%) "
+endif
+
+CLIBS_OPTS := $(CLIBS:%=-cclib -l%)
+ifdef MSVC
+ ifndef STATIC
+ # MSVC libraries do not have 'lib' prefix
+ CLIBS_OPTS := $(CLIBS:%=-cclib %.lib)
+ endif
+endif
+
+ifneq ($(strip $(OBJ_LINK)),)
+ ifdef CREATE_LIB
+ OBJS_LIBS := -cclib -l$(CLIB_BASE) $(CLIBS_OPTS) $(MAYBE_IDL)
+ else
+ OBJS_LIBS := $(OBJ_LINK) $(CLIBS_OPTS) $(MAYBE_IDL)
+ endif
+else
+ OBJS_LIBS := $(CLIBS_OPTS) $(MAYBE_IDL)
+endif
+
+# If we have to make byte-code
+ifndef REAL_OCAMLC
+ BYTE_OCAML := y
+
+ # EXTRADEPS is added dependencies we have to insert for all
+ # executable files we generate. Ideally it should be all of the
+ # libraries we use, but it's hard to find the ones that get searched on
+ # the path since I don't know the paths built into the compiler, so
+ # just include the ones with slashes in their names.
+ EXTRADEPS := $(addsuffix .cma,$(foreach i,$(LIBS),$(if $(findstring /,$(i)),$(i))))
+ SPECIAL_OCAMLFLAGS := $(OCAMLBCFLAGS)
+
+ REAL_OCAMLC := $(INTF_OCAMLC)
+
+ REAL_IMPL := $(IMPL_CMO)
+ REAL_IMPL_INTF := $(IMPLO_INTF)
+ IMPL_SUF := .cmo
+
+ DEPFLAGS :=
+ MAKE_DEPS := $(MLDEPS) $(BCDEPIS)
+
+ ifdef CREATE_LIB
+ CFLAGS := $(PIC_CFLAGS) $(CFLAGS)
+ CPPFLAGS := $(PIC_CPPFLAGS) $(CPPFLAGS)
+ ifndef STATIC
+ ifneq ($(strip $(OBJ_LINK)),)
+ MAKEDLL := $(DLLSONAME)
+ ALL_LDFLAGS := -dllib $(DLLSONAME)
+ endif
+ endif
+ endif
+
+ ifndef NO_CUSTOM
+ ifneq "$(strip $(OBJ_LINK) $(THREADS) $(MAYBE_IDL) $(CLIBS))" ""
+ ALL_LDFLAGS += -custom
+ endif
+ endif
+
+ ALL_LDFLAGS += $(INCFLAGS) $(OCAMLLDFLAGS) $(OCAMLBLDFLAGS) \
+ $(COMMON_LDFLAGS) $(LIBS:%=%.cma)
+ CAMLIDLDLLFLAGS :=
+
+ ifdef THREADS
+ ifdef VMTHREADS
+ THREAD_FLAG := -vmthread
+ else
+ THREAD_FLAG := -thread
+ endif
+ ALL_LDFLAGS := $(THREAD_FLAG) $(ALL_LDFLAGS)
+ ifndef CREATE_LIB
+ ifndef REAL_OCAMLFIND
+ ALL_LDFLAGS := unix.cma threads.cma $(ALL_LDFLAGS)
+ endif
+ endif
+ endif
+
+# we have to make native-code
+else
+ EXTRADEPS := $(addsuffix .cmxa,$(foreach i,$(LIBS),$(if $(findstring /,$(i)),$(i))))
+ ifndef PROFILING
+ SPECIAL_OCAMLFLAGS := $(OCAMLNCFLAGS)
+ PLDFLAGS :=
+ else
+ SPECIAL_OCAMLFLAGS := -p $(OCAMLNCFLAGS)
+ PLDFLAGS := -p
+ endif
+
+ REAL_IMPL := $(IMPL_CMX)
+ REAL_IMPL_INTF := $(IMPLX_INTF)
+ IMPL_SUF := .cmx
+
+ CPPFLAGS := -DNATIVE_CODE $(CPPFLAGS)
+
+ DEPFLAGS := -native
+ MAKE_DEPS := $(MLDEPS) $(NCDEPIS)
+
+ ALL_LDFLAGS := $(PLDFLAGS) $(INCFLAGS) $(OCAMLLDFLAGS) \
+ $(OCAMLNLDFLAGS) $(COMMON_LDFLAGS)
+ CAMLIDLDLLFLAGS := -opt
+
+ ifndef CREATE_LIB
+ ALL_LDFLAGS += $(LIBS:%=%.cmxa)
+ else
+ CFLAGS := $(PIC_CFLAGS) $(CFLAGS)
+ CPPFLAGS := $(PIC_CPPFLAGS) $(CPPFLAGS)
+ endif
+
+ ifdef THREADS
+ THREAD_FLAG := -thread
+ ALL_LDFLAGS := $(THREAD_FLAG) $(ALL_LDFLAGS)
+ ifndef CREATE_LIB
+ ifndef REAL_OCAMLFIND
+ ALL_LDFLAGS := unix.cmxa threads.cmxa $(ALL_LDFLAGS)
+ endif
+ endif
+ endif
+endif
+
+export MAKE_DEPS
+
+ifdef ANNOTATE
+ ANNOT_FLAG := -dtypes
+else
+endif
+
+ALL_OCAMLCFLAGS := $(THREAD_FLAG) $(ANNOT_FLAG) $(OCAMLFLAGS) \
+ $(INCFLAGS) $(SPECIAL_OCAMLFLAGS)
+
+ifdef make_deps
+ -include $(MAKE_DEPS)
+ PRE_TARGETS :=
+endif
+
+###########################################################################
+# USER RULES
+
+# Call "OCamlMakefile QUIET=" to get rid of all of the @'s.
+QUIET=@
+
+# generates byte-code (default)
+byte-code: $(PRE_TARGETS)
+ $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) $(BCRESULT) \
+ REAL_RESULT="$(BCRESULT)" make_deps=yes
+bc: byte-code
+
+byte-code-nolink: $(PRE_TARGETS)
+ $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) nolink \
+ REAL_RESULT="$(BCRESULT)" make_deps=yes
+bcnl: byte-code-nolink
+
+top: $(PRE_TARGETS)
+ $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) $(TOPRESULT) \
+ REAL_RESULT="$(BCRESULT)" make_deps=yes
+
+# generates native-code
+
+native-code: $(PRE_TARGETS)
+ $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) $(NCRESULT) \
+ REAL_RESULT="$(NCRESULT)" \
+ REAL_OCAMLC="$(OCAMLOPT)" \
+ make_deps=yes
+nc: native-code
+
+native-code-nolink: $(PRE_TARGETS)
+ $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) nolink \
+ REAL_RESULT="$(NCRESULT)" \
+ REAL_OCAMLC="$(OCAMLOPT)" \
+ make_deps=yes
+ncnl: native-code-nolink
+
+# generates byte-code libraries
+byte-code-library: $(PRE_TARGETS)
+ $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) \
+ $(RES_CLIB) $(BCRESULT).cma \
+ REAL_RESULT="$(BCRESULT)" \
+ CREATE_LIB=yes \
+ make_deps=yes
+bcl: byte-code-library
+
+# generates native-code libraries
+native-code-library: $(PRE_TARGETS)
+ $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) \
+ $(RES_CLIB) $(NCRESULT).cmxa \
+ REAL_RESULT="$(NCRESULT)" \
+ REAL_OCAMLC="$(OCAMLOPT)" \
+ CREATE_LIB=yes \
+ make_deps=yes
+ncl: native-code-library
+
+ifdef WIN32
+# generates byte-code dll
+byte-code-dll: $(PRE_TARGETS)
+ $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) \
+ $(RES_CLIB) $(BCRESULT).dll \
+ REAL_RESULT="$(BCRESULT)" \
+ make_deps=yes
+bcd: byte-code-dll
+
+# generates native-code dll
+native-code-dll: $(PRE_TARGETS)
+ $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) \
+ $(RES_CLIB) $(NCRESULT).dll \
+ REAL_RESULT="$(NCRESULT)" \
+ REAL_OCAMLC="$(OCAMLOPT)" \
+ make_deps=yes
+ncd: native-code-dll
+endif
+
+# generates byte-code with debugging information
+debug-code: $(PRE_TARGETS)
+ $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) $(BCRESULT) \
+ REAL_RESULT="$(BCRESULT)" make_deps=yes \
+ OCAMLFLAGS="-g $(OCAMLFLAGS)" \
+ OCAMLLDFLAGS="-g $(OCAMLLDFLAGS)"
+dc: debug-code
+
+debug-code-nolink: $(PRE_TARGETS)
+ $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) nolink \
+ REAL_RESULT="$(BCRESULT)" make_deps=yes \
+ OCAMLFLAGS="-g $(OCAMLFLAGS)" \
+ OCAMLLDFLAGS="-g $(OCAMLLDFLAGS)"
+dcnl: debug-code-nolink
+
+# generates byte-code libraries with debugging information
+debug-code-library: $(PRE_TARGETS)
+ $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) \
+ $(RES_CLIB) $(BCRESULT).cma \
+ REAL_RESULT="$(BCRESULT)" make_deps=yes \
+ CREATE_LIB=yes \
+ OCAMLFLAGS="-g $(OCAMLFLAGS)" \
+ OCAMLLDFLAGS="-g $(OCAMLLDFLAGS)"
+dcl: debug-code-library
+
+# generates byte-code for profiling
+profiling-byte-code: $(PRE_TARGETS)
+ $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) $(BCRESULT) \
+ REAL_RESULT="$(BCRESULT)" PROFILING="y" \
+ make_deps=yes
+pbc: profiling-byte-code
+
+# generates native-code
+
+profiling-native-code: $(PRE_TARGETS)
+ $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) $(NCRESULT) \
+ REAL_RESULT="$(NCRESULT)" \
+ REAL_OCAMLC="$(OCAMLOPT)" \
+ PROFILING="y" \
+ make_deps=yes
+pnc: profiling-native-code
+
+# generates byte-code libraries
+profiling-byte-code-library: $(PRE_TARGETS)
+ $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) \
+ $(RES_CLIB) $(BCRESULT).cma \
+ REAL_RESULT="$(BCRESULT)" PROFILING="y" \
+ CREATE_LIB=yes \
+ make_deps=yes
+pbcl: profiling-byte-code-library
+
+# generates native-code libraries
+profiling-native-code-library: $(PRE_TARGETS)
+ $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) \
+ $(RES_CLIB) $(NCRESULT).cmxa \
+ REAL_RESULT="$(NCRESULT)" PROFILING="y" \
+ REAL_OCAMLC="$(OCAMLOPT)" \
+ CREATE_LIB=yes \
+ make_deps=yes
+pncl: profiling-native-code-library
+
+# packs byte-code objects
+pack-byte-code: $(PRE_TARGETS)
+ $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) $(BCRESULT).cmo \
+ REAL_RESULT="$(BCRESULT)" \
+ PACK_LIB=yes make_deps=yes
+pabc: pack-byte-code
+
+# packs native-code objects
+pack-native-code: $(PRE_TARGETS)
+ $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) \
+ $(NCRESULT).cmx $(NCRESULT).o \
+ REAL_RESULT="$(NCRESULT)" \
+ REAL_OCAMLC="$(OCAMLOPT)" \
+ PACK_LIB=yes make_deps=yes
+panc: pack-native-code
+
+# generates HTML-documentation
+htdoc: doc/$(RESULT)/html
+
+# generates Latex-documentation
+ladoc: doc/$(RESULT)/latex
+
+# generates PostScript-documentation
+psdoc: doc/$(RESULT)/latex/doc.ps
+
+# generates PDF-documentation
+pdfdoc: doc/$(RESULT)/latex/doc.pdf
+
+# generates all supported forms of documentation
+doc: htdoc ladoc psdoc pdfdoc
+
+###########################################################################
+# LOW LEVEL RULES
+
+$(REAL_RESULT): $(REAL_IMPL_INTF) $(OBJ_LINK) $(EXTRADEPS) $(RESULTDEPS)
+ $(REAL_OCAMLFIND) $(REAL_OCAMLC) \
+ $(OCAML_FIND_PACKAGES) $(OCAML_FIND_LINKPKG) \
+ $(ALL_LDFLAGS) $(OBJS_LIBS) -o $@$(EXE) \
+ $(REAL_IMPL)
+
+nolink: $(REAL_IMPL_INTF) $(OBJ_LINK)
+
+ifdef WIN32
+$(REAL_RESULT).dll: $(REAL_IMPL_INTF) $(OBJ_LINK)
+ $(CAMLIDLDLL) $(CAMLIDLDLLFLAGS) $(OBJ_LINK) $(CLIBS) \
+ -o $@ $(REAL_IMPL)
+endif
+
+%$(TOPSUFFIX): $(REAL_IMPL_INTF) $(OBJ_LINK) $(EXTRADEPS)
+ $(REAL_OCAMLFIND) $(OCAMLMKTOP) \
+ $(OCAML_FIND_PACKAGES) $(OCAML_FIND_LINKPKG) \
+ $(ALL_LDFLAGS) $(OBJS_LIBS) -o $@$(EXE) \
+ $(REAL_IMPL)
+
+.SUFFIXES: .mli .ml .cmi .cmo .cmx .cma .cmxa .$(EXT_OBJ) \
+ .mly .di .d .$(EXT_LIB) .idl %.oxridl .c .$(EXT_CXX) .h .so \
+ .rep .zog .glade
+
+ifndef STATIC
+ifdef MINGW
+$(DLLSONAME): $(OBJ_LINK)
+ $(CC) $(CFLAGS) $(CFLAGS_WIN32) $(OBJ_LINK) -shared -o $@ \
+ -Wl,--whole-archive $(wildcard $(foreach dir,$(LIBDIRS),$(CLIBS:%=$(dir)/lib%.a))) \
+ $(OCAMLLIBPATH)/ocamlrun.a \
+ -Wl,--export-all-symbols \
+ -Wl,--no-whole-archive
+else
+ifdef MSVC
+$(DLLSONAME): $(OBJ_LINK)
+ link /NOLOGO /DLL /OUT:$@ $(OBJ_LINK) \
+ $(wildcard $(foreach dir,$(LIBDIRS),$(CLIBS:%=$(dir)/%.lib))) \
+ $(OCAMLLIBPATH)/ocamlrun.lib
+
+else
+$(DLLSONAME): $(OBJ_LINK)
+ $(OCAMLMKLIB) $(INCFLAGS) $(CLIBFLAGS) \
+ -o $(CLIB_BASE) $(OBJ_LINK) $(CLIBS:%=-l%) \
+ $(OCAMLMKLIB_FLAGS)
+endif
+endif
+endif
+
+ifndef LIB_PACK_NAME
+$(RESULT).cma: $(REAL_IMPL_INTF) $(MAKEDLL) $(EXTRADEPS) $(RESULTDEPS)
+ $(REAL_OCAMLFIND) $(REAL_OCAMLC) -a $(ALL_LDFLAGS) \
+ $(OBJS_LIBS) -o $@ $(OCAMLBLDFLAGS) $(REAL_IMPL)
+
+$(RESULT).cmxa $(RESULT).$(EXT_LIB): $(REAL_IMPL_INTF) $(EXTRADEPS) $(RESULTDEPS)
+ $(REAL_OCAMLFIND) $(OCAMLOPT) -a $(ALL_LDFLAGS) $(OBJS_LIBS) \
+ $(OCAMLNLDFLAGS) -o $@ $(REAL_IMPL)
+else
+ifdef BYTE_OCAML
+$(LIB_PACK_NAME).cmi $(LIB_PACK_NAME).cmo: $(REAL_IMPL_INTF)
+ $(REAL_OCAMLFIND) $(REAL_OCAMLC) -pack -o $(LIB_PACK_NAME).cmo $(REAL_IMPL)
+else
+$(LIB_PACK_NAME).cmi $(LIB_PACK_NAME).cmx: $(REAL_IMPL_INTF)
+ $(REAL_OCAMLFIND) $(REAL_OCAMLC) -pack -o $(LIB_PACK_NAME).cmx $(REAL_IMPL)
+endif
+
+$(RESULT).cma: $(LIB_PACK_NAME).cmi $(LIB_PACK_NAME).cmo $(MAKEDLL) $(EXTRADEPS) $(RESULTDEPS)
+ $(REAL_OCAMLFIND) $(REAL_OCAMLC) -a $(ALL_LDFLAGS) \
+ $(OBJS_LIBS) -o $@ $(OCAMLBLDFLAGS) $(LIB_PACK_NAME).cmo
+
+$(RESULT).cmxa $(RESULT).$(EXT_LIB): $(LIB_PACK_NAME).cmi $(LIB_PACK_NAME).cmx $(EXTRADEPS) $(RESULTDEPS)
+ $(REAL_OCAMLFIND) $(OCAMLOPT) -a $(ALL_LDFLAGS) $(OBJS_LIBS) \
+ $(OCAMLNLDFLAGS) -o $@ $(LIB_PACK_NAME).cmx
+endif
+
+$(RES_CLIB): $(OBJ_LINK)
+ifndef MSVC
+ ifneq ($(strip $(OBJ_LINK)),)
+ $(AR) rcs $@ $(OBJ_LINK)
+ endif
+else
+ ifneq ($(strip $(OBJ_LINK)),)
+ lib -nologo -debugtype:cv -out:$(RES_CLIB) $(OBJ_LINK)
+ endif
+endif
+
+.mli.cmi: $(EXTRADEPS)
+ $(QUIET)pp=`sed -n -e '/^#/d' -e 's/(\*pp \([^*]*\) \*)/\1/p;q' $<`; \
+ if [ -z "$$pp" ]; then \
+ echo $(REAL_OCAMLFIND) $(INTF_OCAMLC) $(OCAML_FIND_PACKAGES) \
+ -c $(THREAD_FLAG) $(ANNOT_FLAG) \
+ $(OCAMLFLAGS) $(INCFLAGS) $<; \
+ $(REAL_OCAMLFIND) $(INTF_OCAMLC) $(OCAML_FIND_PACKAGES) \
+ -c $(THREAD_FLAG) $(ANNOT_FLAG) \
+ $(OCAMLFLAGS) $(INCFLAGS) $<; \
+ else \
+ echo $(REAL_OCAMLFIND) $(INTF_OCAMLC) $(OCAML_FIND_PACKAGES) \
+ -c -pp \"$$pp $(PPFLAGS)\" $(THREAD_FLAG) $(ANNOT_FLAG) \
+ $(OCAMLFLAGS) $(INCFLAGS) $<; \
+ $(REAL_OCAMLFIND) $(INTF_OCAMLC) $(OCAML_FIND_PACKAGES) \
+ -c -pp "$$pp $(PPFLAGS)" $(THREAD_FLAG) $(ANNOT_FLAG) \
+ $(OCAMLFLAGS) $(INCFLAGS) $<; \
+ fi
+
+.ml.cmi .ml.$(EXT_OBJ) .ml.cmx .ml.cmo: $(EXTRADEPS)
+ $(QUIET)pp=`sed -n -e '/^#/d' -e 's/(\*pp \([^*]*\) \*)/\1/p;q' $<`; \
+ if [ -z "$$pp" ]; then \
+ echo $(REAL_OCAMLFIND) $(REAL_OCAMLC) $(OCAML_FIND_PACKAGES) \
+ -c $(ALL_OCAMLCFLAGS) $<; \
+ $(REAL_OCAMLFIND) $(REAL_OCAMLC) $(OCAML_FIND_PACKAGES) \
+ -c $(ALL_OCAMLCFLAGS) $<; \
+ else \
+ echo $(REAL_OCAMLFIND) $(REAL_OCAMLC) $(OCAML_FIND_PACKAGES) \
+ -c -pp \"$$pp $(PPFLAGS)\" $(ALL_OCAMLCFLAGS) $<; \
+ $(REAL_OCAMLFIND) $(REAL_OCAMLC) $(OCAML_FIND_PACKAGES) \
+ -c -pp "$$pp $(PPFLAGS)" $(ALL_OCAMLCFLAGS) $<; \
+ fi
+
+ifdef PACK_LIB
+$(REAL_RESULT).cmo $(REAL_RESULT).cmx $(REAL_RESULT).o: $(REAL_IMPL_INTF) $(OBJ_LINK) $(EXTRADEPS)
+ $(REAL_OCAMLFIND) $(REAL_OCAMLC) -pack $(ALL_LDFLAGS) \
+ $(OBJS_LIBS) -o $@ $(REAL_IMPL)
+endif
+
+.PRECIOUS: %.ml
+%.ml: %.mll
+ $(OCAMLLEX) $<
+
+.PRECIOUS: %.ml %.mli
+%.ml %.mli: %.mly
+ $(OCAMLYACC) $(YFLAGS) $<
+ $(QUIET)pp=`sed -n -e 's/.*(\*pp \([^*]*\) \*).*/\1/p;q' $<`; \
+ if [ ! -z "$$pp" ]; then \
+ mv $*.ml $*.ml.temporary; \
+ echo "(*pp $$pp $(PPFLAGS)*)" > $*.ml; \
+ cat $*.ml.temporary >> $*.ml; \
+ rm $*.ml.temporary; \
+ mv $*.mli $*.mli.temporary; \
+ echo "(*pp $$pp $(PPFLAGS)*)" > $*.mli; \
+ cat $*.mli.temporary >> $*.mli; \
+ rm $*.mli.temporary; \
+ fi
+
+
+.PRECIOUS: %.ml
+%.ml: %.rep
+ $(CAMELEON_REPORT) $(CAMELEON_REPORT_FLAGS) -gen $<
+
+.PRECIOUS: %.ml
+%.ml: %.zog
+ $(CAMELEON_ZOGGY) $(CAMELEON_ZOGGY_FLAGS) -impl $< > $@
+
+.PRECIOUS: %.ml
+%.ml: %.glade
+ $(OCAML_GLADECC) $(OCAML_GLADECC_FLAGS) $< > $@
+
+.PRECIOUS: %.ml %.mli
+%.ml %.mli: %.oxridl
+ $(OXRIDL) $<
+
+.PRECIOUS: %.ml %.mli %_stubs.c %.h
+%.ml %.mli %_stubs.c %.h: %.idl
+ $(CAMLIDL) $(MAYBE_IDL_HEADER) $(IDLFLAGS) \
+ $(CAMLIDLFLAGS) $<
+ $(QUIET)if [ $(NOIDLHEADER) ]; then touch $*.h; fi
+
+.c.$(EXT_OBJ):
+ $(OCAMLC) -c -cc "$(CC)" -ccopt "$(CFLAGS) \
+ $(CPPFLAGS) $(CPPFLAGS_WIN32) \
+ $(CFLAGS_WIN32) $(CINCFLAGS) $(CFLAG_O)$@ " $<
+
+.$(EXT_CXX).$(EXT_OBJ):
+ $(CXX) -c $(CXXFLAGS) $(CINCFLAGS) $(CPPFLAGS) \
+ -I'$(OCAMLLIBPATH)' \
+ $< $(CFLAG_O)$@
+
+$(MLDEPDIR)/%.d: %.ml
+ $(QUIET)echo making $@ from $<
+ $(QUIET)if [ ! -d $(@D) ]; then mkdir -p $(@D); fi
+ $(QUIET)pp=`sed -n -e '/^#/d' -e 's/(\*pp \([^*]*\) \*)/\1/p;q' $<`; \
+ if [ -z "$$pp" ]; then \
+ $(REAL_OCAMLFIND) $(OCAMLDEP) $(OCAML_DEP_PACKAGES) \
+ $(DINCFLAGS) $< > $@; \
+ else \
+ $(REAL_OCAMLFIND) $(OCAMLDEP) $(OCAML_DEP_PACKAGES) \
+ -pp "$$pp $(PPFLAGS)" $(DINCFLAGS) $< > $@; \
+ fi
+
+$(BCDIDIR)/%.di $(NCDIDIR)/%.di: %.mli
+ $(QUIET)echo making $@ from $<
+ $(QUIET)if [ ! -d $(@D) ]; then mkdir -p $(@D); fi
+ $(QUIET)pp=`sed -n -e '/^#/d' -e 's/(\*pp \([^*]*\) \*)/\1/p;q' $<`; \
+ if [ -z "$$pp" ]; then \
+ $(REAL_OCAMLFIND) $(OCAMLDEP) $(DEPFLAGS) $(DINCFLAGS) $< > $@; \
+ else \
+ $(REAL_OCAMLFIND) $(OCAMLDEP) $(DEPFLAGS) \
+ -pp "$$pp $(PPFLAGS)" $(DINCFLAGS) $< > $@; \
+ fi
+
+doc/$(RESULT)/html: $(DOC_FILES)
+ rm -rf $@
+ mkdir -p $@
+ $(QUIET)pp=`sed -n -e '/^#/d' -e 's/(\*pp \([^*]*\) \*)/\1/p;q' $<`; \
+ if [ -z "$$pp" ]; then \
+ echo $(OCAMLDOC) -html -d $@ $(OCAMLDOCFLAGS) $(INCFLAGS) $(DOC_FILES); \
+ $(OCAMLDOC) -html -d $@ $(OCAMLDOCFLAGS) $(INCFLAGS) $(DOC_FILES); \
+ else \
+ echo $(OCAMLDOC) -pp \"$$pp $(PPFLAGS)\" -html -d $@ $(OCAMLDOCFLAGS) \
+ $(INCFLAGS) $(DOC_FILES); \
+ $(OCAMLDOC) -pp "$$pp $(PPFLAGS)" -html -d $@ $(OCAMLDOCFLAGS) \
+ $(INCFLAGS) $(DOC_FILES); \
+ fi
+
+doc/$(RESULT)/latex: $(DOC_FILES)
+ rm -rf $@
+ mkdir -p $@
+ $(QUIET)pp=`sed -n -e '/^#/d' -e 's/(\*pp \([^*]*\) \*)/\1/p;q' $<`; \
+ if [ -z "$$pp" ]; then \
+ echo $(OCAMLDOC) -latex $(OCAMLDOCFLAGS) $(INCFLAGS) \
+ $(DOC_FILES) -o $@/doc.tex; \
+ $(OCAMLDOC) -latex $(OCAMLDOCFLAGS) $(INCFLAGS) $(DOC_FILES) \
+ -o $@/doc.tex; \
+ else \
+ echo $(OCAMLDOC) -pp \"$$pp $(PPFLAGS)\" -latex $(OCAMLDOCFLAGS) \
+ $(INCFLAGS) $(DOC_FILES) -o $@/doc.tex; \
+ $(OCAMLDOC) -pp "$$pp $(PPFLAGS)" -latex $(OCAMLDOCFLAGS) \
+ $(INCFLAGS) $(DOC_FILES) -o $@/doc.tex; \
+ fi
+
+doc/$(RESULT)/latex/doc.ps: doc/$(RESULT)/latex
+ cd doc/$(RESULT)/latex && \
+ $(LATEX) doc.tex && \
+ $(LATEX) doc.tex && \
+ $(DVIPS) $(DVIPSFLAGS) doc.dvi -o $(@F)
+
+doc/$(RESULT)/latex/doc.pdf: doc/$(RESULT)/latex/doc.ps
+ cd doc/$(RESULT)/latex && $(PS2PDF) $(<F)
+
+define make_subproj
+.PHONY:
+subproj_$(1):
+ $$(eval $$(call PROJ_$(1)))
+ $(QUIET)if [ "$(SUBTARGET)" != "all" ]; then \
+ $(MAKE) -f $(OCAMLMAKEFILE) $(SUBTARGET); \
+ fi
+endef
+
+$(foreach subproj,$(SUBPROJS),$(eval $(call make_subproj,$(subproj))))
+
+.PHONY:
+subprojs: $(SUBPROJS:%=subproj_%)
+
+###########################################################################
+# (UN)INSTALL RULES FOR LIBRARIES
+
+.PHONY: libinstall
+libinstall: all
+ $(QUIET)printf "\nInstalling library with ocamlfind\n"
+ $(OCAMLFIND) install $(OCAMLFIND_INSTFLAGS) $(RESULT) META $(LIBINSTALL_FILES)
+ $(QUIET)printf "\nInstallation successful.\n"
+
+.PHONY: libuninstall
+libuninstall:
+ $(QUIET)printf "\nUninstalling library with ocamlfind\n"
+ $(OCAMLFIND) remove $(OCAMLFIND_INSTFLAGS) $(RESULT)
+ $(QUIET)printf "\nUninstallation successful.\n"
+
+.PHONY: rawinstall
+rawinstall: all
+ $(QUIET)printf "\nInstalling library to: $(OCAML_LIB_INSTALL)\n"
+ -install -d $(OCAML_LIB_INSTALL)
+ for i in $(LIBINSTALL_FILES); do \
+ if [ -f $$i ]; then \
+ install -c -m 0644 $$i $(OCAML_LIB_INSTALL); \
+ fi; \
+ done
+ $(QUIET)printf "\nInstallation successful.\n"
+
+.PHONY: rawuninstall
+rawuninstall:
+ $(QUIET)printf "\nUninstalling library from: $(OCAML_LIB_INSTALL)\n"
+ cd $(OCAML_LIB_INSTALL) && rm $(notdir $(LIBINSTALL_FILES))
+ $(QUIET)printf "\nUninstallation successful.\n"
+
+###########################################################################
+# MAINTAINANCE RULES
+
+.PHONY: clean
+clean::
+ rm -f $(TARGETS) $(TRASH)
+ rm -rf $(BCDIDIR) $(NCDIDIR) $(MLDEPDIR)
+
+.PHONY: cleanup
+cleanup::
+ rm -f $(NONEXECS) $(TRASH)
+ rm -rf $(BCDIDIR) $(NCDIDIR) $(MLDEPDIR)
+
+.PHONY: clean-doc
+clean-doc::
+ rm -rf doc
+
+.PHONY: nobackup
+nobackup:
+ rm -f *.bak *~ *.dup
--- /dev/null
+(** PDB.ml
+ *
+ * Dispatch debugger commands to the appropriate context
+ *
+ * @author copyright (c) 2005 alex ho
+ * @see <www.cl.cam.ac.uk/netos/pdb> pervasive debugger
+ * @version 1
+ *)
+
+exception Unimplemented of string
+exception Unknown_context of string
+exception Unknown_domain
+
+type context_t =
+ | Void
+ | Event_channel
+ | Domain of Domain.context_t
+ | Process of Process.context_t
+
+let string_of_context ctx =
+ match ctx with
+ | Void -> "{void}"
+ | Event_channel -> "{event channel}"
+ | Domain d -> Domain.string_of_context d
+ | Process p -> Process.string_of_context p
+
+
+
+let read_registers ctx =
+ match ctx with
+ | Domain d -> Domain.read_registers d
+ | _ -> Intel.null_registers
+
+let write_register ctx register value =
+ match ctx with
+ | Domain d -> Domain.write_register d register value
+ | _ -> raise (Unimplemented "write register")
+
+
+let read_memory ctx addr len =
+ match ctx with
+ | Domain d -> Domain.read_memory d addr len
+ | _ -> raise (Unimplemented "read memory")
+
+let write_memory ctx addr values =
+ match ctx with
+ | Domain d -> Domain.write_memory d addr values
+ | _ -> raise (Unimplemented "write memory")
+
+
+let continue ctx =
+ match ctx with
+ | Domain d -> Domain.continue d
+ | _ -> raise (Unimplemented "continue")
+
+let step ctx =
+ match ctx with
+ | Domain d -> Domain.step d
+ | _ -> raise (Unimplemented "step")
+
+
+let insert_memory_breakpoint ctx addr len =
+ match ctx with
+ | Domain d -> Domain.insert_memory_breakpoint d addr len
+ | _ -> raise (Unimplemented "insert memory breakpoint")
+
+let remove_memory_breakpoint ctx addr len =
+ match ctx with
+ | Domain d -> Domain.remove_memory_breakpoint d addr len
+ | _ -> raise (Unimplemented "remove memory breakpoint")
+
+
+let pause ctx =
+ match ctx with
+ | Domain d -> Domain.pause d
+ | _ -> raise (Unimplemented "pause target")
+
+
+let attach_debugger ctx =
+ match ctx with
+ | Domain d -> Domain.attach_debugger (Domain.get_domain d)
+ (Domain.get_execution_domain d)
+ | _ -> raise (Unimplemented "attach debugger")
+
+let detach_debugger ctx =
+ match ctx with
+ | Domain d -> Domain.detach_debugger (Domain.get_domain d)
+ (Domain.get_execution_domain d)
+ | _ -> raise (Unimplemented "detach debugger")
+
+external open_debugger : unit -> unit = "open_context"
+external close_debugger : unit -> unit = "close_context"
+
+(* this is just the domains right now... expand to other contexts later *)
+external debugger_status : unit -> unit = "debugger_status"
+
+
+(***********************************************************)
+
+
+let hash = Hashtbl.create 10
+
+let debug_contexts () =
+ print_endline "context list:";
+ let print_context key ctx =
+ match ctx with
+ | Void -> print_endline (Printf.sprintf " [%s] {void}"
+ (Util.get_connection_info key))
+ | Event_channel -> print_endline (Printf.sprintf " [%s] {event_channel}"
+ (Util.get_connection_info key))
+ | Process p -> print_endline (Printf.sprintf " [%s] %s"
+ (Util.get_connection_info key)
+ (Process.string_of_context p))
+ | Domain d -> print_endline (Printf.sprintf " [%s] %s"
+ (Util.get_connection_info key)
+ (Domain.string_of_context d))
+ in
+ Hashtbl.iter print_context hash
+
+(** add_context : add a new context to the hash table.
+ * if there is an existing context for the same key then it
+ * is first removed implictly by the hash table replace function.
+ *)
+let add_context (key:Unix.file_descr) context params =
+ match context with
+ | "void" -> Hashtbl.replace hash key Void
+ | "event channel" -> Hashtbl.replace hash key Event_channel
+ | "domain" ->
+ begin
+ match params with
+ | dom::exec_dom::_ ->
+ let d = Domain(Domain.new_context dom exec_dom) in
+ attach_debugger d;
+ Hashtbl.replace hash key d
+ | _ -> failwith "bogus parameters to domain context"
+ end
+ | "process" ->
+ begin
+ match params with
+ | dom::pid::_ ->
+ let p = Process.new_context dom pid in
+ Hashtbl.replace hash key (Process(p))
+ | _ -> failwith "bogus parameters to process context"
+ end
+ | _ -> raise (Unknown_context context)
+
+let add_default_context sock =
+ add_context sock "void" []
+
+let find_context key =
+ try
+ Hashtbl.find hash key
+ with
+ Not_found ->
+ print_endline "error: (find_context) PDB context not found";
+ raise Not_found
+
+let delete_context key =
+ Hashtbl.remove hash key
+
+(** find_domain : Locate the context(s) matching a particular domain
+ * and execution_domain pair.
+ *)
+
+let find_domain dom exec_dom =
+ let find key ctx list =
+ match ctx with
+ | Domain d ->
+ if (((Domain.get_domain d) = dom) &&
+ ((Domain.get_execution_domain d) = exec_dom))
+ then
+ key :: list
+ else
+ list
+ | _ -> list
+ in
+ let sock_list = Hashtbl.fold find hash [] in
+ match sock_list with
+ | hd::tl -> hd
+ | [] -> raise Unknown_domain
--- /dev/null
+(** Process.ml
+ *
+ * process context implementation
+ *
+ * @author copyright (c) 2005 alex ho
+ * @see <www.cl.cam.ac.uk/netos/pdb> pervasive debugger
+ * @version 1
+ *)
+
+open Int32
+open Intel
+
+type context_t =
+{
+ mutable domain : int;
+ mutable process : int;
+}
+
+let default_context = { domain = 0; process = 0 }
+
+let new_context dom proc = { domain = dom; process = proc }
+
+let string_of_context ctx =
+ Printf.sprintf "{process} domain: %d, process: %d"
+ ctx.domain ctx.process
+
+let set_domain ctx value =
+ ctx.domain <- value;
+ print_endline (Printf.sprintf "ctx.domain <- %d" ctx.domain)
+
+let set_process ctx value =
+ ctx.process <- value;
+ print_endline (Printf.sprintf "ctx.process <- %d" ctx.process)
+
+let get_domain ctx =
+ ctx.domain
+
+let get_process ctx =
+ ctx.process
--- /dev/null
+(** Process.mli
+ *
+ * process context interface
+ *
+ * @author copyright (c) 2005 alex ho
+ * @see <www.cl.cam.ac.uk/netos/pdb> pervasive debugger
+ * @version 1
+ *)
+
+type context_t
+
+val default_context : context_t
+val new_context : int -> int -> context_t
+
+val set_domain : context_t -> int -> unit
+val get_domain : context_t -> int
+val set_process : context_t -> int -> unit
+val get_process : context_t -> int
+
+val string_of_context : context_t -> string
--- /dev/null
+(** Util.ml
+ *
+ * various utility functions
+ *
+ * @author copyright (c) 2005 alex ho
+ * @see <www.cl.cam.ac.uk/netos/pdb> pervasive debugger
+ * @version 1
+ *)
+
+let int_of_hexchar h =
+ let i = int_of_char h in
+ match h with
+ | '0' .. '9' -> i - (int_of_char '0')
+ | 'a' .. 'f' -> i - (int_of_char 'a') + 10
+ | 'A' .. 'F' -> i - (int_of_char 'A') + 10
+ | _ -> raise (Invalid_argument "unknown hex character")
+
+let hexchar_of_int i =
+ let hexchars = [| '0'; '1'; '2'; '3'; '4'; '5'; '6'; '7';
+ '8'; '9'; 'a'; 'b'; 'c'; 'd'; 'e'; 'f' |]
+ in
+ hexchars.(i)
+
+
+(** flip the bytes of a four byte int
+ *)
+
+let flip_int num =
+ let a = num mod 256
+ and b = (num / 256) mod 256
+ and c = (num / (256 * 256)) mod 256
+ and d = (num / (256 * 256 * 256)) in
+ (a * 256 * 256 * 256) + (b * 256 * 256) + (c * 256) + d
+
+
+let flip_int32 num =
+ let a = Int32.logand num 0xffl
+ and b = Int32.logand (Int32.shift_right_logical num 8) 0xffl
+ and c = Int32.logand (Int32.shift_right_logical num 16) 0xffl
+ and d = (Int32.shift_right_logical num 24) in
+ (Int32.logor
+ (Int32.logor (Int32.shift_left a 24) (Int32.shift_left b 16))
+ (Int32.logor (Int32.shift_left c 8) d))
+
+
+let int_list_of_string_list list =
+ List.map (fun x -> int_of_string x) list
+
+let int_list_of_string str len =
+ let array_of_string s =
+ let int_array = Array.make len 0 in
+ for loop = 0 to len - 1 do
+ int_array.(loop) <- (Char.code s.[loop]);
+ done;
+ int_array
+ in
+ Array.to_list (array_of_string str)
+
+
+(* remove leading and trailing whitespace from a string *)
+
+let chomp str =
+ let head = Str.regexp "^[ \t\r\n]+" in
+ let tail = Str.regexp "[ \t\r\n]+$" in
+ let str = Str.global_replace head "" str in
+ Str.global_replace tail "" str
+
+(* Stupid little parser for "<key>=<value>[,<key>=<value>]*"
+ It first chops the entire command at each ',', so no ',' in key or value!
+ Mucked to return a list of words for "value"
+ *)
+
+let list_of_string str =
+ let delim c = Str.regexp ("[ \t]*" ^ c ^ "[ \t]*") in
+ let str_list = Str.split (delim " ") str in
+ List.map (fun x -> chomp(x)) str_list
+
+let little_parser fn str =
+ let delim c = Str.regexp ("[ \t]*" ^ c ^ "[ \t]*") in
+ let str_list = Str.split (delim ",") str in
+ let pair s =
+ match Str.split (delim "=") s with
+ | [key;value] -> fn (chomp key) (list_of_string value)
+ | [key] -> fn (chomp key) []
+ | _ -> failwith (Printf.sprintf "error: (little_parser) parse error [%s]" str)
+ in
+ List.iter pair str_list
+
+(* boolean list membership test *)
+let not_list_member the_list element =
+ try
+ List.find (fun x -> x = element) the_list;
+ false
+ with
+ Not_found -> true
+
+(* a very inefficient way to remove the elements of one list from another *)
+let list_remove the_list remove_list =
+ List.filter (not_list_member remove_list) the_list
+
+(* get a description of a file descriptor *)
+let get_connection_info fd =
+ let get_local_info fd =
+ let sockname = Unix.getsockname fd in
+ match sockname with
+ | Unix.ADDR_UNIX(s) -> s
+ | Unix.ADDR_INET(a,p) -> ((Unix.string_of_inet_addr a) ^ ":" ^
+ (string_of_int p))
+ and get_remote_info fd =
+ let sockname = Unix.getpeername fd in
+ match sockname with
+ | Unix.ADDR_UNIX(s) -> s
+ | Unix.ADDR_INET(a,p) -> ((Unix.string_of_inet_addr a) ^ ":" ^
+ (string_of_int p))
+ in
+ try
+ get_remote_info fd
+ with
+ | Unix.Unix_error (Unix.ENOTSOCK, s1, s2) ->
+ let s = Unix.fstat fd in
+ Printf.sprintf "dev: %d, inode: %d" s.Unix.st_dev s.Unix.st_ino
+ | _ -> get_local_info fd
+
+
+(* really write a string *)
+let really_write fd str =
+ let strlen = String.length str in
+ let sent = ref 0 in
+ while (!sent < strlen) do
+ sent := !sent + (Unix.write fd str !sent (strlen - !sent))
+ done
+
+let write_character fd ch =
+ let str = String.create 1 in
+ str.[0] <- ch;
+ really_write fd str
+
+
+
+let send_reply fd reply =
+ let checksum = ref 0 in
+ write_character fd '$';
+ for loop = 0 to (String.length reply) - 1 do
+ write_character fd reply.[loop];
+ checksum := !checksum + int_of_char reply.[loop]
+ done;
+ write_character fd '#';
+ write_character fd (hexchar_of_int ((!checksum mod 256) / 16));
+ write_character fd (hexchar_of_int ((!checksum mod 256) mod 16))
+ (*
+ * BUG NEED TO LISTEN FOR REPLY +/- AND POSSIBLY RE-TRANSMIT
+ *)
+
--- /dev/null
+(** debugger.ml
+ *
+ * main debug functionality
+ *
+ * @author copyright (c) 2005 alex ho
+ * @see <www.cl.cam.ac.uk/netos/pdb> pervasive debugger
+ * @version 1
+ *)
+
+open Intel
+open PDB
+open Util
+open Str
+
+(** a few debugger commands such as step 's' and continue 'c' do
+ * not immediately return a response to the debugger. in these
+ * cases we raise No_reply instead.
+ *)
+exception No_reply
+
+let initialize_debugger () =
+ ()
+
+let exit_debugger () =
+ ()
+
+
+(**
+ Detach Command
+ Note: response is ignored by gdb. We leave the context in the
+ hash. It will be cleaned up with the socket is closed.
+ *)
+let gdb_detach ctx =
+ PDB.detach_debugger ctx;
+ raise No_reply
+
+(**
+ Kill Command
+ Note: response is ignored by gdb. We leave the context in the
+ hash. It will be cleaned up with the socket is closed.
+ *)
+let gdb_kill () =
+ ""
+
+
+
+(**
+ Continue Command.
+ resume the target
+ *)
+let gdb_continue ctx =
+ PDB.continue ctx;
+ raise No_reply
+
+(**
+ Step Command.
+ single step the target
+ *)
+let gdb_step ctx =
+ PDB.step ctx;
+ raise No_reply
+
+
+(**
+ Read Registers Command.
+ returns 16 4-byte registers in a particular defined by gdb.
+ *)
+let gdb_read_registers ctx =
+ let regs = PDB.read_registers ctx in
+ let str =
+ (Printf.sprintf "%08lx" (Util.flip_int32 regs.eax)) ^
+ (Printf.sprintf "%08lx" (Util.flip_int32 regs.ecx)) ^
+ (Printf.sprintf "%08lx" (Util.flip_int32 regs.edx)) ^
+ (Printf.sprintf "%08lx" (Util.flip_int32 regs.ebx)) ^
+ (Printf.sprintf "%08lx" (Util.flip_int32 regs.esp)) ^
+ (Printf.sprintf "%08lx" (Util.flip_int32 regs.ebp)) ^
+ (Printf.sprintf "%08lx" (Util.flip_int32 regs.esi)) ^
+ (Printf.sprintf "%08lx" (Util.flip_int32 regs.edi)) ^
+ (Printf.sprintf "%08lx" (Util.flip_int32 regs.eip)) ^
+ (Printf.sprintf "%08lx" (Util.flip_int32 regs.eflags)) ^
+ (Printf.sprintf "%08lx" (Util.flip_int32 regs.cs)) ^
+ (Printf.sprintf "%08lx" (Util.flip_int32 regs.ss)) ^
+ (Printf.sprintf "%08lx" (Util.flip_int32 regs.ds)) ^
+ (Printf.sprintf "%08lx" (Util.flip_int32 regs.es)) ^
+ (Printf.sprintf "%08lx" (Util.flip_int32 regs.fs)) ^
+ (Printf.sprintf "%08lx" (Util.flip_int32 regs.gs)) in
+ str
+
+(**
+ Set Thread Command
+ *)
+let gdb_set_thread command =
+ "OK"
+
+
+(**
+ Read Memory Packets
+ *)
+let gdb_read_memory ctx command =
+ let int_list_to_string i str =
+ (Printf.sprintf "%02x" i) ^ str
+ in
+ let read_mem addr len =
+ try
+ let mem = PDB.read_memory ctx addr len in
+ List.fold_right int_list_to_string mem ""
+ with
+ Failure s -> "E02"
+ in
+ Scanf.sscanf command "m%lx,%d" read_mem
+
+
+
+(**
+ Write Memory Packets
+ *)
+let gdb_write_memory ctx command =
+ let write_mem addr len =
+ print_endline (Printf.sprintf " gdb_write_memory %lx %x\n" addr len);
+ print_endline (Printf.sprintf " [[ unimplemented ]]\n")
+ in
+ Scanf.sscanf command "M%lx,%d" write_mem;
+ "OK"
+
+
+
+(**
+ Write Register Packets
+ *)
+let gdb_write_register ctx command =
+ let write_reg reg goofy_val =
+ let new_val = Util.flip_int32 goofy_val in
+ match reg with
+ | 0 -> PDB.write_register ctx EAX new_val
+ | 1 -> PDB.write_register ctx ECX new_val
+ | 2 -> PDB.write_register ctx EDX new_val
+ | 3 -> PDB.write_register ctx EBX new_val
+ | 4 -> PDB.write_register ctx ESP new_val
+ | 5 -> PDB.write_register ctx EBP new_val
+ | 6 -> PDB.write_register ctx ESI new_val
+ | 7 -> PDB.write_register ctx EDI new_val
+ | 8 -> PDB.write_register ctx EIP new_val
+ | 9 -> PDB.write_register ctx EFLAGS new_val
+ | 10 -> PDB.write_register ctx CS new_val
+ | 11 -> PDB.write_register ctx SS new_val
+ | 12 -> PDB.write_register ctx DS new_val
+ | 13 -> PDB.write_register ctx ES new_val
+ | 14 -> PDB.write_register ctx FS new_val
+ | 15 -> PDB.write_register ctx GS new_val
+ | _ -> print_endline (Printf.sprintf "write unknown register [%d]" reg)
+ in
+ Scanf.sscanf command "P%x=%lx" write_reg;
+ "OK"
+
+
+(**
+ General Query Packets
+ *)
+let gdb_query command =
+ match command with
+ | "qC" -> ""
+ | "qOffsets" -> ""
+ | "qSymbol::" -> ""
+ | _ ->
+ print_endline (Printf.sprintf "unknown gdb query packet [%s]" command);
+ "E01"
+
+
+(**
+ Write Memory Binary Packets
+ *)
+let gdb_write_memory_binary ctx command =
+ let write_mem addr len =
+ let pos = Str.search_forward (Str.regexp ":") command 0 in
+ let txt = Str.string_after command (pos + 1) in
+ PDB.write_memory ctx addr (int_list_of_string txt len)
+ in
+ Scanf.sscanf command "X%lx,%d" write_mem;
+ "OK"
+
+
+
+(**
+ Last Signal Command
+ *)
+let gdb_last_signal =
+ "S00"
+
+
+
+
+(**
+ Process PDB extensions to the GDB serial protocol.
+ Changes the mutable context state.
+ *)
+let pdb_extensions command sock =
+ let process_extension key value =
+ (* since this command can change the context, we need to grab it each time *)
+ let ctx = PDB.find_context sock in
+ match key with
+ | "status" ->
+ print_endline (string_of_context ctx);
+ PDB.debug_contexts ();
+ debugger_status ()
+ | "context" ->
+ PDB.add_context sock (List.hd value)
+ (int_list_of_string_list (List.tl value))
+ | _ -> failwith (Printf.sprintf "unknown pdb extension command [%s:%s]"
+ key (List.hd value))
+ in
+ try
+ Util.little_parser process_extension
+ (String.sub command 1 ((String.length command) - 1));
+ "OK"
+ with
+ | Unknown_context s ->
+ print_endline (Printf.sprintf "unknown context [%s]" s);
+ "E01"
+ | Failure s -> "E01"
+
+
+(**
+ Insert Breakpoint or Watchpoint Packet
+ *)
+let gdb_insert_bwcpoint ctx command =
+ let insert cmd addr length =
+ try
+ match cmd with
+ | 0 -> PDB.insert_memory_breakpoint ctx addr length; "OK"
+ | _ -> ""
+ with
+ Failure s -> "E03"
+ in
+ Scanf.sscanf command "Z%d,%lx,%d" insert
+
+(**
+ Remove Breakpoint or Watchpoint Packet
+ *)
+let gdb_remove_bwcpoint ctx command =
+ let insert cmd addr length =
+ try
+ match cmd with
+ | 0 -> PDB.remove_memory_breakpoint ctx addr length; "OK"
+ | _ -> ""
+ with
+ Failure s -> "E04"
+ in
+ Scanf.sscanf command "z%d,%lx,%d" insert
+
+(**
+ Do Work!
+
+ @param command char list
+ *)
+
+let process_command command sock =
+ let ctx = PDB.find_context sock in
+ try
+ match command.[0] with
+ | 'c' -> gdb_continue ctx
+ | 'D' -> gdb_detach ctx
+ | 'g' -> gdb_read_registers ctx
+ | 'H' -> gdb_set_thread command
+ | 'k' -> gdb_kill ()
+ | 'm' -> gdb_read_memory ctx command
+ | 'M' -> gdb_write_memory ctx command
+ | 'P' -> gdb_write_register ctx command
+ | 'q' -> gdb_query command
+ | 's' -> gdb_step ctx
+ | 'x' -> pdb_extensions command sock
+ | 'X' -> gdb_write_memory_binary ctx command
+ | '?' -> gdb_last_signal
+ | 'z' -> gdb_remove_bwcpoint ctx command
+ | 'Z' -> gdb_insert_bwcpoint ctx command
+ | _ ->
+ print_endline (Printf.sprintf "unknown gdb command [%s]" command);
+ ""
+ with
+ Unimplemented s ->
+ print_endline (Printf.sprintf "loser. unimplemented command [%s][%s]"
+ command s);
+ ""
+
+
+(**
+ process_evtchn
+
+ This is called each time a virq_pdb is sent from xen to dom 0.
+ It is sent by Xen when a domain hits a breakpoint.
+
+ Think of this as the continuation function for a "c" or "s" command.
+*)
+
+external query_domain_stop : unit -> (int * int) list = "query_domain_stop"
+(* returns a list of paused domains : () -> (domain, vcpu) list *)
+
+let process_evtchn fd =
+ let channel = Evtchn.read fd in
+ let find_pair (dom, vcpu) =
+ print_endline (Printf.sprintf "checking %d.%d" dom vcpu);
+ try
+ let sock = PDB.find_domain dom vcpu in
+ true
+ with
+ Unknown_domain -> false
+ in
+ let dom_list = query_domain_stop () in
+ let (dom, vcpu) = List.find find_pair dom_list in
+ let vec = 3 in
+ let sock = PDB.find_domain dom vcpu in
+ print_endline (Printf.sprintf "handle bkpt d:%d ed:%d v:%d %s"
+ dom vcpu vec (Util.get_connection_info sock));
+ Util.send_reply sock "S05";
+ Evtchn.unmask fd channel (* allow next virq *)
+
--- /dev/null
+(** evtchn.ml
+ *
+ * event channel interface
+ *
+ * @author copyright (c) 2005 alex ho
+ * @see <www.cl.cam.ac.uk/netos/pdb> pervasive debugger
+ * @version 1
+ *)
+
+let dev_name = "/dev/xen/evtchn" (* EVTCHN_DEV_NAME *)
+let dev_major = 10 (* EVTCHN_DEV_MAJOR *)
+let dev_minor = 201 (* EVTCHN_DEV_MINOR *)
+
+let virq_pdb = 6 (* as defined VIRQ_PDB *)
+
+external bind_virq : int -> int = "evtchn_bind_virq"
+external bind : Unix.file_descr -> int -> unit = "evtchn_bind"
+external unbind : Unix.file_descr -> int -> unit = "evtchn_unbind"
+external ec_open : string -> int -> int -> Unix.file_descr = "evtchn_open"
+external read : Unix.file_descr -> int = "evtchn_read"
+external ec_close : Unix.file_descr -> unit = "evtchn_close"
+external unmask : Unix.file_descr -> int -> unit = "evtchn_unmask"
+
+let setup () =
+ let port = bind_virq virq_pdb in
+ let fd = ec_open dev_name dev_major dev_minor in
+ bind fd port;
+ fd
+
+let teardown fd =
+ unbind fd virq_pdb;
+ ec_close fd
--- /dev/null
+(** evtchn.mli
+ *
+ * event channel interface
+ *
+ * @author copyright (c) 2005 alex ho
+ * @see <www.cl.cam.ac.uk/netos/pdb> pervasive debugger
+ * @version 1
+ *)
+
+
+val setup : unit -> Unix.file_descr
+val read : Unix.file_descr -> int
+val teardown : Unix.file_descr -> unit
+val unmask : Unix.file_descr -> int -> unit
--- /dev/null
+/*
+ * pdb_caml_xc.c
+ *
+ * http://www.cl.cam.ac.uk/netos/pdb
+ *
+ * OCaml to libxc interface library for PDB
+ */
+
+#include <xc.h>
+#include <xc_debug.h>
+#include <errno.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include <sys/mman.h>
+#include <caml/alloc.h>
+#include <caml/fail.h>
+#include <caml/memory.h>
+#include <caml/mlvalues.h>
+
+int pdb_evtchn_bind_virq (int xc_handle, int virq, int *port);
+int xen_evtchn_bind (int evtchn_fd, int idx);
+int xen_evtchn_unbind (int evtchn_fd, int idx);
+
+/* this order comes from xen/include/public/arch-x86_32.h */
+enum x86_registers { PDB_EBX, PDB_ECX, PDB_EDX, PDB_ESI, PDB_EDI,
+ PDB_EBP, PDB_EAX, PDB_Error_code, PDB_Entry_vector,
+ PDB_EIP, PDB_CS, PDB_EFLAGS, PDB_ESP, PDB_SS,
+ PDB_ES, PDB_DS, PDB_FS, PDB_GS };
+
+static void dump_regs (cpu_user_regs_t *ctx);
+
+static int xc_handle = -1;
+
+typedef struct
+{
+ int domain;
+ int vcpu;
+} context_t;
+
+#define decode_context(_ctx, _ocaml) \
+{ \
+ (_ctx)->domain = Int_val(Field((_ocaml),0)); \
+ (_ctx)->vcpu = Int_val(Field((_ocaml),1)); \
+}
+
+#define encode_context(_ctx, _ocaml) \
+{ \
+ (_ocaml) = caml_alloc_tuple(2); \
+ Store_field((_ocaml), 0, Val_int((_ctx)->domain)); \
+ Store_field((_ocaml), 1, Val_int((_ctx)->vcpu)); \
+}
+
+
+/****************************************************************************/
+
+/*
+ * open_context : unit -> unit
+ */
+value
+open_context (value unit)
+{
+ CAMLparam1(unit);
+
+ xc_handle = xc_interface_open();
+
+ if ( xc_handle < 0 )
+ {
+ fprintf(stderr, "(pdb) error opening xc interface: %d (%s)\n",
+ errno, strerror(errno));
+ }
+
+ CAMLreturn(Val_unit);
+}
+
+/*
+ * close_context : unit -> unit
+ */
+value
+close_context (value unit)
+{
+ CAMLparam1(unit);
+ int rc;
+
+ if ( (rc = xc_interface_close(xc_handle)) < 0 )
+ {
+ fprintf(stderr, "(pdb) error closing xc interface: %d (%s)\n",
+ errno, strerror(errno));
+ }
+
+ CAMLreturn(Val_unit);
+}
+
+/*
+ * read_registers : context_t -> int32
+ */
+value
+read_registers (value context)
+{
+ CAMLparam1(context);
+ CAMLlocal1(result);
+
+ cpu_user_regs_t *regs;
+ context_t ctx;
+
+ decode_context(&ctx, context);
+
+ if ( xc_debug_read_registers(xc_handle, ctx.domain, ctx.vcpu, ®s) )
+ {
+ printf("(pdb) read registers error!\n"); fflush(stdout);
+ failwith("read registers error");
+ }
+
+ dump_regs(regs);
+
+ result = caml_alloc_tuple(18); /* FIXME */
+
+ Store_field(result, 0, caml_copy_int32(regs->ebx));
+ Store_field(result, 1, caml_copy_int32(regs->ecx));
+ Store_field(result, 2, caml_copy_int32(regs->edx));
+ Store_field(result, 3, caml_copy_int32(regs->esi));
+ Store_field(result, 4, caml_copy_int32(regs->edi));
+ Store_field(result, 5, caml_copy_int32(regs->ebp));
+ Store_field(result, 6, caml_copy_int32(regs->eax));
+ Store_field(result, 7, caml_copy_int32(regs->error_code)); /* 16 */
+ Store_field(result, 8, caml_copy_int32(regs->entry_vector)); /* 16 */
+ Store_field(result, 9, caml_copy_int32(regs->eip));
+ Store_field(result, 10, caml_copy_int32(regs->cs)); /* 16 */
+ Store_field(result, 11, caml_copy_int32(regs->eflags));
+ Store_field(result, 12, caml_copy_int32(regs->esp));
+ Store_field(result, 13, caml_copy_int32(regs->ss)); /* 16 */
+ Store_field(result, 14, caml_copy_int32(regs->es)); /* 16 */
+ Store_field(result, 15, caml_copy_int32(regs->ds)); /* 16 */
+ Store_field(result, 16, caml_copy_int32(regs->fs)); /* 16 */
+ Store_field(result, 17, caml_copy_int32(regs->gs)); /* 16 */
+
+ CAMLreturn(result);
+}
+
+
+/*
+ * write_register : context_t -> register -> int32 -> unit
+ */
+value
+write_register (value context, value reg, value newval)
+{
+ CAMLparam3(context, reg, newval);
+
+ int my_reg = Int_val(reg);
+ int val = Int32_val(newval);
+
+ context_t ctx;
+ cpu_user_regs_t *regs;
+
+ printf("(pdb) write register\n");
+
+ decode_context(&ctx, context);
+
+ if ( xc_debug_read_registers(xc_handle, ctx.domain, ctx.vcpu, ®s) )
+ {
+ printf("(pdb) write register (get) error!\n"); fflush(stdout);
+ failwith("write register error");
+ }
+
+ switch (my_reg)
+ {
+ case PDB_EBX: regs->ebx = val; break;
+ case PDB_ECX: regs->ecx = val; break;
+ case PDB_EDX: regs->edx = val; break;
+ case PDB_ESI: regs->esi = val; break;
+ case PDB_EDI: regs->edi = val; break;
+
+ case PDB_EBP: regs->ebp = val; break;
+ case PDB_EAX: regs->eax = val; break;
+ case PDB_Error_code: regs->error_code = val; break;
+ case PDB_Entry_vector: regs->entry_vector = val; break;
+
+ case PDB_EIP: regs->eip = val; break;
+ case PDB_CS: regs->cs = val; break;
+ case PDB_EFLAGS: regs->eflags = val; break;
+ case PDB_ESP: regs->esp = val; break;
+ case PDB_SS: regs->ss = val; break;
+ case PDB_ES: regs->es = val; break;
+ case PDB_DS: regs->ds = val; break;
+ case PDB_FS: regs->fs = val; break;
+ case PDB_GS: regs->gs = val; break;
+ }
+
+ if ( xc_debug_write_registers(xc_handle, ctx.domain, ctx.vcpu, regs) )
+ {
+ printf("(pdb) write register (set) error!\n"); fflush(stdout);
+ failwith("write register error");
+ }
+
+ CAMLreturn(Val_unit);
+}
+
+/*
+ * read_memory : context_t -> int32 -> int -> int
+ */
+value
+read_memory (value context, value address, value length)
+{
+ CAMLparam3(context, address, length);
+ CAMLlocal2(result, temp);
+
+ context_t ctx;
+ int loop;
+ char *buffer;
+ memory_t my_address = Int32_val(address);
+ u32 my_length = Int_val(length);
+
+ printf ("(pdb) read memory\n");
+
+ decode_context(&ctx, context);
+
+ buffer = malloc(my_length);
+ if (buffer == NULL)
+ {
+ printf("(pdb) read memory: malloc failed.\n"); fflush(stdout);
+ failwith("read memory error");
+ }
+
+ if ( xc_debug_read_memory(xc_handle, ctx.domain, ctx.vcpu,
+ my_address, my_length, buffer) )
+ {
+ printf("(pdb) read memory error!\n"); fflush(stdout);
+ failwith("read memory error");
+ }
+
+ result = caml_alloc(2,0);
+ if ( my_length > 0 ) /* car */
+ {
+ Store_field(result, 0, Val_int(buffer[my_length - 1] & 0xff));
+ }
+ else
+
+ {
+ Store_field(result, 0, Val_int(0));
+ }
+ Store_field(result, 1, Val_int(0)); /* cdr */
+
+ for (loop = 1; loop < my_length; loop++)
+ {
+ temp = result;
+ result = caml_alloc(2,0);
+ Store_field(result, 0, Val_int(buffer[my_length - loop - 1] & 0xff));
+ Store_field(result, 1, temp);
+ }
+
+ CAMLreturn(result);
+}
+
+/*
+ * write_memory : context_t -> int32 -> int list -> unit
+ */
+value
+write_memory (value context, value address, value val_list)
+{
+ CAMLparam3(context, address, val_list);
+ CAMLlocal1(node);
+
+ context_t ctx;
+
+ char buffer[4096]; /* a big buffer */
+ memory_t my_address;
+ u32 length = 0;
+
+ printf ("(pdb) write memory\n");
+
+ decode_context(&ctx, context);
+
+ node = val_list;
+ if ( Int_val(node) == 0 ) /* gdb functionalty test uses empty list */
+ {
+ CAMLreturn(Val_unit);
+ }
+
+ while ( Int_val(Field(node,1)) != 0 )
+ {
+ buffer[length++] = Int_val(Field(node, 0));
+ node = Field(node,1);
+ }
+ buffer[length++] = Int_val(Field(node, 0));
+
+ my_address = (memory_t) Int32_val(address);
+
+ if ( xc_debug_write_memory(xc_handle, ctx.domain, ctx.vcpu,
+ my_address, length, buffer) )
+ {
+ printf("(pdb) write memory error!\n"); fflush(stdout);
+ failwith("write memory error");
+ }
+
+ CAMLreturn(Val_unit);
+}
+
+
+/*********************************************************************/
+
+void
+dump_regs (cpu_user_regs_t *regs)
+{
+ printf (" eax: %x\n", regs->eax);
+ printf (" ecx: %x\n", regs->ecx);
+ printf (" edx: %x\n", regs->edx);
+ printf (" ebx: %x\n", regs->ebx);
+ printf (" esp: %x\n", regs->esp);
+ printf (" ebp: %x\n", regs->ebp);
+ printf (" esi: %x\n", regs->esi);
+ printf (" edi: %x\n", regs->edi);
+ printf (" eip: %x\n", regs->eip);
+ printf (" flags: %x\n", regs->eflags);
+ printf (" cs: %x\n", regs->cs);
+ printf (" ss: %x\n", regs->ss);
+ printf (" es: %x\n", regs->es);
+ printf (" ds: %x\n", regs->ds);
+ printf (" fs: %x\n", regs->fs);
+ printf (" gs: %x\n", regs->gs);
+
+ return;
+}
+
+/*
+ * continue_target : context_t -> unit
+ */
+value
+continue_target (value context)
+{
+ CAMLparam1(context);
+
+ context_t ctx;
+
+ decode_context(&ctx, context);
+
+ if ( xc_debug_continue(xc_handle, ctx.domain, ctx.vcpu) )
+ {
+ printf("(pdb) continue\n"); fflush(stdout);
+ failwith("continue");
+ }
+
+ CAMLreturn(Val_unit);
+}
+
+/*
+ * step_target : context_t -> unit
+ */
+value
+step_target (value context)
+{
+ CAMLparam1(context);
+
+ context_t ctx;
+
+ decode_context(&ctx, context);
+
+ if ( xc_debug_step(xc_handle, ctx.domain, ctx.vcpu) )
+ {
+ printf("(pdb) step\n"); fflush(stdout);
+ failwith("step");
+ }
+
+ CAMLreturn(Val_unit);
+}
+
+
+
+/*
+ * insert_memory_breakpoint : context_t -> int32 -> int list -> unit
+ */
+value
+insert_memory_breakpoint (value context, value address, value length)
+{
+ CAMLparam3(context, address, length);
+
+ context_t ctx;
+ memory_t my_address = (memory_t) Int32_val(address);
+ int my_length = Int_val(length);
+
+ decode_context(&ctx, context);
+
+ printf ("(pdb) insert memory breakpoint 0x%lx %d\n",
+ my_address, my_length);
+
+ if ( xc_debug_insert_memory_breakpoint(xc_handle, ctx.domain, ctx.vcpu,
+ my_address, my_length) )
+ {
+ printf("(pdb) error: insert memory breakpoint\n"); fflush(stdout);
+ failwith("insert memory breakpoint");
+ }
+
+
+ CAMLreturn(Val_unit);
+}
+
+/*
+ * remove_memory_breakpoint : context_t -> int32 -> int list -> unit
+ */
+value
+remove_memory_breakpoint (value context, value address, value length)
+{
+ CAMLparam3(context, address, length);
+
+ context_t ctx;
+
+ memory_t my_address = (memory_t) Int32_val(address);
+ int my_length = Int_val(length);
+
+ printf ("(pdb) remove memory breakpoint 0x%lx %d\n",
+ my_address, my_length);
+
+ decode_context(&ctx, context);
+
+ if ( xc_debug_remove_memory_breakpoint(xc_handle,
+ ctx.domain, ctx.vcpu,
+ my_address, my_length) )
+ {
+ printf("(pdb) error: remove memory breakpoint\n"); fflush(stdout);
+ failwith("remove memory breakpoint");
+ }
+
+ CAMLreturn(Val_unit);
+}
+
+/*
+ * attach_debugger : int -> int -> unit
+ */
+value
+attach_debugger (value domain, value vcpu)
+{
+ CAMLparam2(domain, vcpu);
+
+ int my_domain = Int_val(domain);
+ int my_vcpu = Int_val(vcpu);
+
+ printf ("(pdb) attach domain [%d.%d]\n", my_domain, my_vcpu);
+
+ if ( xc_debug_attach(xc_handle, my_domain, my_vcpu) )
+ {
+ printf("(pdb) attach error!\n"); fflush(stdout);
+ failwith("attach error");
+ }
+
+ CAMLreturn(Val_unit);
+}
+
+
+/*
+ * detach_debugger : int -> int -> unit
+ */
+value
+detach_debugger (value domain, value vcpu)
+{
+ CAMLparam2(domain, vcpu);
+
+ int my_domain = Int_val(domain);
+ int my_vcpu = Int_val(vcpu);
+
+ printf ("(pdb) detach domain [%d.%d]\n", my_domain, my_vcpu);
+
+ if ( xc_debug_detach(xc_handle, my_domain, my_vcpu) )
+ {
+ printf("(pdb) detach error!\n"); fflush(stdout);
+ failwith("detach error");
+ }
+
+ CAMLreturn(Val_unit);
+}
+
+
+/*
+ * debugger_status : unit -> unit
+ */
+value
+debugger_status (value unit)
+{
+ CAMLparam1(unit);
+
+ printf ("(pdb) debugger status\n");
+
+ CAMLreturn(Val_unit);
+}
+
+/*
+ * pause_target : int -> unit
+ */
+value
+pause_target (value domid)
+{
+ CAMLparam1(domid);
+
+ int my_domid = Int_val(domid);
+
+ printf ("(pdb) pause target %d\n", my_domid);
+
+ xc_domain_pause(xc_handle, my_domid);
+
+ CAMLreturn(Val_unit);
+}
+
+/****************************************************************************/
+/****************************************************************************/
+
+/*
+ * query_domain_stop : unit -> (int * int) list
+ */
+value
+query_domain_stop (value unit)
+{
+ CAMLparam1(unit);
+ CAMLlocal3(result, temp, node);
+
+ int max_domains = 20;
+ int dom_list[max_domains];
+ int loop, count;
+
+ count = xc_debug_query_domain_stop(xc_handle, dom_list, max_domains);
+ if ( count < 0 )
+ {
+ printf("(pdb) query domain stop!\n"); fflush(stdout);
+ failwith("query domain stop");
+ }
+
+ printf ("QDS: %d\n", count);
+ for (loop = 0; loop < count; loop ++)
+ printf (" %d %d\n", loop, dom_list[loop]);
+
+ result = caml_alloc(2,0);
+ if ( count > 0 ) /* car */
+ {
+ node = caml_alloc(2,0);
+ Store_field(node, 0, Val_int(dom_list[0])); /* domain id */
+ Store_field(node, 1, Val_int(0)); /* vcpu */
+ Store_field(result, 0, node);
+ }
+ else
+ {
+ Store_field(result, 0, Val_int(0));
+ }
+ Store_field(result, 1, Val_int(0)); /* cdr */
+
+ for ( loop = 1; loop < count; loop++ )
+ {
+ temp = result;
+ result = caml_alloc(2,0);
+ node = caml_alloc(2,0);
+ Store_field(node, 0, Val_int(dom_list[loop])); /* domain id */
+ Store_field(node, 1, Val_int(0)); /* vcpu */
+ Store_field(result, 0, node);
+ Store_field(result, 1, temp);
+ }
+
+ CAMLreturn(result);
+}
+
+/****************************************************************************/
+/****************************************************************************/
+
+#include <errno.h>
+#include <sys/ioctl.h>
+#include <sys/stat.h>
+#include <fcntl.h>
+#include <unistd.h>
+
+/*
+ * evtchn_open : string -> int -> int -> Unix.file_descr
+ *
+ * OCaml's Unix library doesn't have mknod, so it makes more sense just write
+ * this in C. This code is from Keir/Andy.
+ */
+value
+evtchn_open (value filename, value major, value minor)
+{
+ CAMLparam3(filename, major, minor);
+
+ char *myfilename = String_val(filename);
+ int mymajor = Int_val(major);
+ int myminor = Int_val(minor);
+ int evtchn_fd;
+ struct stat st;
+
+ /* Make sure any existing device file links to correct device. */
+ if ( (lstat(myfilename, &st) != 0) ||
+ !S_ISCHR(st.st_mode) ||
+ (st.st_rdev != makedev(mymajor, myminor)) )
+ {
+ (void)unlink(myfilename);
+ }
+
+ reopen:
+ evtchn_fd = open(myfilename, O_RDWR);
+ if ( evtchn_fd == -1 )
+ {
+ if ( (errno == ENOENT) &&
+ ((mkdir("/dev/xen", 0755) == 0) || (errno == EEXIST)) &&
+ (mknod(myfilename, S_IFCHR|0600, makedev(mymajor,myminor)) == 0) )
+ {
+ goto reopen;
+ }
+ return -errno;
+ }
+
+ CAMLreturn(Val_int(evtchn_fd));
+}
+
+/*
+ * evtchn_bind_virq : int -> int
+ */
+value
+evtchn_bind_virq (value virq)
+{
+ CAMLparam1(virq);
+
+ int port;
+
+ if ( pdb_evtchn_bind_virq(xc_handle, Int_val(virq), &port) < 0 )
+ {
+ printf("(pdb) evtchn_bind_virq error!\n"); fflush(stdout);
+ failwith("evtchn_bind_virq error");
+ }
+
+ CAMLreturn(Val_int(port));
+}
+
+/*
+ * evtchn_bind : Unix.file_descr -> int -> unit
+ */
+value
+evtchn_bind (value fd, value idx)
+{
+ CAMLparam2(fd, idx);
+
+ int myfd = Int_val(fd);
+ int myidx = Int_val(idx);
+
+ if ( xen_evtchn_bind(myfd, myidx) < 0 )
+ {
+ printf("(pdb) evtchn_bind error!\n"); fflush(stdout);
+ failwith("evtchn_bind error");
+ }
+
+ CAMLreturn(Val_unit);
+}
+
+/*
+ * evtchn_unbind : Unix.file_descr -> int -> unit
+ */
+value
+evtchn_unbind (value fd, value idx)
+{
+ CAMLparam2(fd, idx);
+
+ int myfd = Int_val(fd);
+ int myidx = Int_val(idx);
+
+ if ( xen_evtchn_unbind(myfd, myidx) < 0 )
+ {
+ printf("(pdb) evtchn_unbind error!\n"); fflush(stdout);
+ failwith("evtchn_unbind error");
+ }
+
+ CAMLreturn(Val_unit);
+}
+
+/*
+ * evtchn_read : Unix.file_descr -> int
+ */
+value
+evtchn_read (value fd)
+{
+ CAMLparam1(fd);
+
+ u16 v;
+ int bytes;
+ int rc = -1;
+ int myfd = Int_val(fd);
+
+ while ( (bytes = read(myfd, &v, sizeof(v))) == -1 )
+ {
+ if ( errno == EINTR ) continue;
+ rc = -errno;
+ goto exit;
+ }
+
+ if ( bytes == sizeof(v) )
+ rc = v;
+
+ exit:
+ CAMLreturn(Val_int(rc));
+}
+
+
+/*
+ * evtchn_close : Unix.file_descr -> unit
+ */
+value
+evtchn_close (value fd)
+{
+ CAMLparam1(fd);
+ int myfd = Int_val(fd);
+
+ (void)close(myfd);
+
+ CAMLreturn(Val_unit);
+}
+
+/*
+ * evtchn_unmask : Unix.file_descr -> int -> unit
+ */
+value
+evtchn_unmask (value fd, value idx)
+{
+ CAMLparam1(fd);
+
+ int myfd = Int_val(fd);
+ u16 myidx = Int_val(idx);
+
+ (void)write(myfd, &myidx, sizeof(myidx));
+
+ CAMLreturn(Val_unit);
+}
+
+/*
+ * Local variables:
+ * mode: C
+ * c-set-style: "BSD"
+ * c-basic-offset: 4
+ * tab-width: 4
+ * indent-tabs-mode: nil
+ * End:
+ */
+
--- /dev/null
+/*
+ * pdb_xen.c
+ *
+ * alex ho
+ * http://www.cl.cam.ac.uk/netos/pdb
+ *
+ * PDB interface library for accessing Xen
+ */
+
+#include <xc.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include <errno.h>
+#include <string.h>
+#include <sys/mman.h>
+
+int
+pdb_open ()
+{
+ int xc_handle = xc_interface_open();
+
+ if ( xc_handle < 0 )
+ {
+ fprintf(stderr, "(pdb) error opening xc interface: %d (%s)\n",
+ errno, strerror(errno));
+ }
+ return xc_handle;
+}
+
+int
+pdb_close (int xc_handle)
+{
+ int rc;
+
+
+ if ( (rc = xc_interface_close(xc_handle)) < 0 )
+ {
+ fprintf(stderr, "(pdb) error closing xc interface: %d (%s)\n",
+ errno, strerror(errno));
+ }
+ return rc;
+}
+
+
+int
+pdb_evtchn_bind_virq (int xc_handle, int virq, int *port)
+{
+ int rc;
+
+ if ( (rc = xc_evtchn_bind_virq(xc_handle, virq, port) < 0 ) )
+ {
+ fprintf(stderr, "(pdb) error binding virq to event channel: %d (%s)\n",
+ errno, strerror(errno));
+ }
+ return rc;
+}
+
+
+#include <sys/ioctl.h>
+
+/* /dev/xen/evtchn ioctls */
+#define EVTCHN_RESET _IO('E', 1) /* clear & reinit buffer */
+#define EVTCHN_BIND _IO('E', 2) /* bind to event channel */
+#define EVTCHN_UNBIND _IO('E', 3) /* unbind from event channel */
+
+int
+xen_evtchn_bind (int evtchn_fd, int idx)
+{
+ if ( ioctl(evtchn_fd, EVTCHN_BIND, idx) != 0 )
+ return -errno;
+
+ return 0;
+}
+
+int
+xen_evtchn_unbind (int evtchn_fd, int idx)
+{
+ if ( ioctl(evtchn_fd, EVTCHN_UNBIND, idx) != 0 )
+ return -errno;
+
+ return 0;
+}
+
+
+/*
+ * Local variables:
+ * mode: C
+ * c-set-style: "BSD"
+ * c-basic-offset: 4
+ * tab-width: 4
+ * indent-tabs-mode: nil
+ * End:
+ */
--- /dev/null
+(** server.ml
+ *
+ * PDB server main loop
+ *
+ * @author copyright (c) 2005 alex ho
+ * @see <www.cl.cam.ac.uk/netos/pdb> pervasive debugger
+ * @version 1
+ *)
+
+open Unix
+open Buffer
+
+
+(**
+ * connection_t: The state for each connection.
+ * buffer & length contains bytes that have been read from the sock
+ * but not yet parsed / processed.
+ *)
+type connection_t =
+{
+ fd : file_descr;
+ mutable buffer : string;
+ mutable length : int;
+}
+
+
+(**
+ * validate_checksum: Compute and compare the checksum of a string
+ * against the provided checksum using the gdb serial protocol algorithm.
+ *
+ *)
+let validate_checksum command checksum =
+ let c0 = ref 0 in
+ for loop = 0 to (String.length command - 1) do
+ c0 := !c0 + int_of_char(command.[loop]);
+ done;
+ if (String.length checksum) = 2
+ then
+ let c1 = Util.int_of_hexchar(checksum.[1]) +
+ Util.int_of_hexchar(checksum.[0]) * 16 in
+ (!c0 mod 256) = (c1 mod 256)
+ else
+ false
+
+
+(**
+ * process_input: Oh, joy! Someone sent us a message. Let's open the
+ * envelope and see what they have to say.
+ *
+ * This function is a paradigm of inefficiency; it performs as many
+ * string copies as possible.
+ *)
+let process_input conn sock =
+ let max_buffer_size = 1024 in
+ let in_string = String.create max_buffer_size in
+
+ let length = read sock in_string 0 max_buffer_size in
+ conn.buffer <- conn.buffer ^ (String.sub in_string 0 length);
+ conn.length <- conn.length + length;
+ let re = Str.regexp "[^\\$]*\\$\\([^#]*\\)#\\(..\\)" in
+
+ begin
+ try
+ let break = String.index conn.buffer '\003' + 1 in
+ print_endline (Printf.sprintf "{{%s}}" (String.escaped conn.buffer));
+
+ (* discard everything seen before the ctrl-c *)
+ conn.buffer <- String.sub conn.buffer break (conn.length - break);
+ conn.length <- conn.length - break;
+
+ (* pause the target *)
+ PDB.pause (PDB.find_context sock);
+
+ (* send a code back to the debugger *)
+ Util.send_reply sock "S05"
+
+ with
+ Not_found -> ()
+ end;
+
+ (* with gdb this is unlikely to loop since you ack each packet *)
+ while ( Str.string_match re conn.buffer 0 ) do
+ let command = Str.matched_group 1 conn.buffer in
+ let checksum = Str.matched_group 2 conn.buffer in
+ let match_end = Str.group_end 2 in
+
+ begin
+ match validate_checksum command checksum with
+ | true ->
+ begin
+ Util.write_character sock '+';
+ try
+ let reply = Debugger.process_command command sock in
+ print_endline (Printf.sprintf "[%s] %s -> \"%s\""
+ (Util.get_connection_info sock)
+ (String.escaped command)
+ (String.escaped reply));
+ Util.send_reply sock reply
+ with
+ Debugger.No_reply ->
+ print_endline (Printf.sprintf "[%s] %s -> null"
+ (Util.get_connection_info sock)
+ (String.escaped command))
+ end
+ | false ->
+ Util.write_character sock '-';
+ end;
+
+ conn.buffer <- String.sub conn.buffer match_end (conn.length - match_end);
+ conn.length <- conn.length - match_end;
+ done;
+ if length = 0 then raise End_of_file
+
+
+
+(** main_server_loop.
+ *
+ * connection_hash is a hash (duh!) with one connection_t for each
+ * open connection.
+ *
+ * in_list is a list of active sockets. it also contains two
+ * magic entries: server_sock for accepting new entries and
+ * event_sock for Xen event channel asynchronous notifications.
+ *)
+let main_server_loop sockaddr =
+ let connection_hash = Hashtbl.create 10
+ in
+ let process_socket svr_sock sockets sock =
+ let (new_list, closed_list) = sockets in
+ if sock == svr_sock
+ then
+ begin
+ let (new_sock, caller) = accept sock in
+ print_endline (Printf.sprintf "[%s] new connection from %s"
+ (Util.get_connection_info sock)
+ (Util.get_connection_info new_sock));
+ Hashtbl.add connection_hash new_sock
+ {fd=new_sock; buffer=""; length = 0};
+ PDB.add_default_context new_sock;
+ (new_sock :: new_list, closed_list)
+ end
+ else
+ begin
+ try
+ match PDB.find_context sock with
+ | PDB.Event_channel ->
+ print_endline (Printf.sprintf "[%s] event channel"
+ (Util.get_connection_info sock));
+ Debugger.process_evtchn sock;
+ (new_list, closed_list)
+ | _ ->
+ let conn = Hashtbl.find connection_hash sock in
+ process_input conn sock;
+ (new_list, closed_list)
+ with
+ | Not_found ->
+ print_endline "error: (main_svr_loop) context not found";
+ PDB.debug_contexts ();
+ raise Not_found
+ | End_of_file ->
+ print_endline (Printf.sprintf "[%s] close connection from %s"
+ (Util.get_connection_info sock)
+ (Util.get_connection_info sock));
+ PDB.delete_context sock;
+ Hashtbl.remove connection_hash sock;
+ close sock;
+ (new_list, sock :: closed_list)
+ end
+ in
+ let rec helper in_list server_sock =
+ (*
+ * List.iter (fun x->Printf.printf "{%s} "
+ * (Util.get_connection_info x)) in_list;
+ * Printf.printf "\n";
+ *)
+ let (rd_list, _, _) = select in_list [] [] (-1.0) in
+ let (new_list, closed_list) = List.fold_left (process_socket server_sock)
+ ([],[]) rd_list in
+ let merge_list = Util.list_remove (new_list @ in_list) closed_list in
+ helper merge_list server_sock
+ in
+ try
+ let server_sock = socket (domain_of_sockaddr sockaddr) SOCK_STREAM 0 in
+ setsockopt server_sock SO_REUSEADDR true;
+ bind server_sock sockaddr;
+ listen server_sock 2;
+
+ PDB.open_debugger ();
+ let event_sock = Evtchn.setup () in
+ PDB.add_context event_sock "event channel" [];
+ helper [server_sock; event_sock] server_sock
+ with
+ | Sys.Break ->
+ print_endline "break: cleaning up";
+ PDB.close_debugger ();
+ Hashtbl.iter (fun sock conn -> close sock) connection_hash
+ | Unix_error(e,err,param) ->
+ Printf.printf "unix error: [%s][%s][%s]\n" (error_message e) err param
+ | Sys_error s -> Printf.printf "sys error: [%s]\n" s
+ | Failure s -> Printf.printf "failure: [%s]\n" s
+ | End_of_file -> Printf.printf "end of file\n"
+
+
+let get_port () =
+ if (Array.length Sys.argv) = 2
+ then
+ int_of_string Sys.argv.(1)
+ else
+ begin
+ print_endline (Printf.sprintf "syntax error: %s <port>" Sys.argv.(0));
+ exit 1
+ end
+
+
+let main =
+ let address = inet_addr_any in
+ let port = get_port () in
+ main_server_loop (ADDR_INET(address, port))
+
CFLAGS += -DDOMU_DEBUG
endif
+ifeq ($(pdb),y)
+CFLAGS += -g -DPDB_DEBUG
+endif
+
+
ifeq ($(crash_debug),y)
CFLAGS += -g -DCRASH_DEBUG
endif
#define debugger_trap_fatal(_v, _r) (0)
#define debugger_trap_immediate()
+#elif defined(PDB_DEBUG)
+
+#include <xen/event.h>
+#include <xen/softirq.h>
+#include <xen/sched.h>
+#include <asm/regs.h>
+
+static inline int debugger_trap_entry(unsigned int vector,
+ struct cpu_user_regs *regs)
+{
+ struct vcpu *vcpu = current;
+
+ if ( !KERNEL_MODE(vcpu, regs) || (vcpu->domain->domain_id == 0) )
+ return 0;
+
+ switch ( vector )
+ {
+ case TRAP_debug:
+ case TRAP_int3:
+ {
+ struct vcpu *ptr;
+
+ /* suspend the guest domain */
+ for_each_vcpu ( vcpu->domain, ptr )
+ {
+ test_and_set_bit(_VCPUF_ctrl_pause, &ptr->vcpu_flags);
+ }
+ sync_lazy_execstate_mask(vcpu->domain->cpumask); /* TLB flush */
+ raise_softirq(SCHEDULE_SOFTIRQ);
+
+ /* notify the debugger */
+ send_guest_virq(dom0->vcpu[0], VIRQ_PDB);
+
+ return 1;
+ }
+ default:
+ break;
+ }
+
+ return 0;
+}
+
+#define debugger_trap_fatal(_v, _r) (0)
+#define debugger_trap_immediate()
#elif 0
#define VIRQ_DOM_EXC 3 /* (DOM0) Exceptional event for some domain. */
#define VIRQ_PARITY_ERR 4 /* (DOM0) NMI parity error. */
#define VIRQ_IO_ERR 5 /* (DOM0) NMI I/O error. */
+#define VIRQ_PDB 6 /* (DOM0) PDB */
#define NR_VIRQS 7
/*
projects / xen.git / commitdiff